VERSION 5.00
Begin VB.UserControl vbalCommandBar 
   Alignable       =   -1  'True
   AutoRedraw      =   -1  'True
   CanGetFocus     =   0   'False
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ControlContainer=   -1  'True
   PropertyPages   =   "vbalCommandBar.ctx":0000
   ScaleHeight     =   240
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   320
   ToolboxBitmap   =   "vbalCommandBar.ctx":001C
   Begin VB.Timer tmrMenuPopup 
      Enabled         =   0   'False
      Interval        =   250
      Left            =   1080
      Top             =   1680
   End
   Begin VB.Timer tmrLostMouse 
      Enabled         =   0   'False
      Interval        =   50
      Left            =   480
      Top             =   1680
   End
End
Attribute VB_Name = "vbalCommandBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
Option Explicit

' API calls
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" ( _
    ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" ( _
   ByVal hLibModule As Long) As Long
Private Declare Sub InitCommonControls Lib "COMCTL32.DLL" ()

Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
   Private Const GWL_STYLE = (-16)
   Private Const WS_BORDER = &H800000
   Private Const WS_CHILD = &H40000000
   Private Const WS_DISABLED = &H8000000
   Private Const WS_VISIBLE = &H10000000
   Private Const WS_TABSTOP = &H100000
   Private Const WS_HSCROLL = &H100000
   Private Const GWL_EXSTYLE = (-20)
   Private Const WS_EX_TOPMOST = &H8&
   Private Const WS_EX_CLIENTEDGE = &H200&
   Private Const WS_EX_STATICEDGE = &H20000
   Private Const WS_EX_WINDOWEDGE = &H100&
   Private Const WS_EX_APPWINDOW = &H40000
   Private Const WS_EX_TOOLWINDOW = &H80&
   Private Const WS_EX_LAYERED As Long = &H80000

Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
   Private Const SWP_FRAMECHANGED = &H20        '  The frame changed: send WM_NCCALCSIZE
   Private Const SWP_NOACTIVATE = &H10
   Private Const SWP_NOMOVE = &H2
   Private Const SWP_NOOWNERZORDER = &H200      '  Don't do owner Z ordering
   Private Const SWP_NOREDRAW = &H8
   Private Const SWP_NOSIZE = &H1
   Private Const SWP_NOZORDER = &H4
   Private Const SWP_SHOWWINDOW = &H40
   Private Const HWND_DESKTOP = 0
   Private Const HWND_NOTOPMOST = -2
   Private Const HWND_TOP = 0
   Private Const HWND_TOPMOST = -1
   Private Const HWND_BOTTOM = 1

Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

Private Const WM_ACTIVATEAPP = &H1C
Private Const WM_SETTINGCHANGE = &H1A&

Public Enum EToolBarStyle
   ' Render using Office XP style
   eOfficeXP
   ' Render using Office 2003 style (the default)
   eOffice2003
   ' Render using MS Money style
   eMoney
   ' Render using same style as System's ComCtl32.DLL
   eComCtl32
End Enum

Public Enum ECustomColors
   [_eccCustomColorFirst]
   eccButtonTextColor
   eccButtonTextHotColor
   eccButtonTextDisabledColor
   eccButtonBackgroundColorStart
   eccButtonBackgroundColorEnd
   eccButtonHotBackgroundColorStart
   eccButtonHotBackgroundColorEnd
   eccButtonCheckedBackgroundColorStart
   eccButtonCheckedBackgroundColorEnd
   eccButtonCheckedHotBackgroundColorStart
   eccButtonCheckedHotBackgroundColorEnd
   eccMenuShadowColor
   eccMenuBorderColor
   eccMenuTextColor
   eccMenuTextHotColor
   eccMenuTextDisabledColor
   eccMenuBackgroundColorStart
   eccMenuBackgroundColorEnd
   eccMenuHotBackgroundColorStart
   eccMenuHotBackgroundColorEnd
   eccMenuHotBorderColor
   eccMenuCheckedBackgroundColorStart
   eccMenuCheckedBackgroundColorEnd
   eccMenuCheckedHotBackgroundColorStart
   eccMenuCheckedHotBackgroundColorEnd
   eccIconDisabledColor
   eccLightColor
   eccDarkColor
   eccGradientColorStart
   eccGradientColorEnd
   [_eccCustomColorLast]
End Enum

Public Enum EButtonStyle
   
   ' A normal push button
   eNormal
   
   ' A group separator
   eSeparator
   
   ' A button which is split and should have a drop down
   eSplit
   
   ' A panel which holds a control. When the toolbar is shown
   ' in a vertical orientation, the panel is either hidden or,
   ' if the object has a valid icon index, it is displayed
   ' as a push button.
   ePanel
      
   ' A checkable button.
   eCheck
   
   ' A checkable button that toggles off any other buttons in
   ' the group when checked. In a radio group at least one
   ' button must be checked.
   eRadio
   
   ' A checkable button that toggles off any other button
   ' in the group when checked.  In a nullable radio group
   ' a checked radio button can be unchecked.
   eRadioNullable
   
End Enum

Public Enum ECommandBarOrientation
   eTop
   eLeft
   eRight
   eBottom
End Enum

Public Enum ECommandBarButtonTextPosition
   eButtonTextSide
   eButtonTextBottom
End Enum

Private m_hWnd As Long
Private m_hWndParent As Long
Private m_bDesignTime As Boolean
Private m_hMod As Long

Private m_bInUse As Boolean
Private m_hWndShownFrom As Long
Private m_hWndShownFromParent As Long
Private m_eMenuPopoutDirection As ECommandBarOrientation
Private m_lMenuPopoutStart As Long
Private m_lMenuPopoutExtent As Long
Private m_hMonitorOn As Long
Private m_eMenuTrackMode As Long
Private m_tLastMousePos As POINTAPI

Private m_bEnabled As Boolean
Private m_bVisible As Boolean
Private m_bRedraw As Boolean
Private m_bMainMenu As Boolean
Private m_bResizeInterlock As Boolean
Private m_eButtonPosition As ECommandBarButtonTextPosition

Private m_bPopup As Boolean
Private m_bPopupVisibleChecks As Boolean
Private m_bWrappable As Boolean

Private m_eOrientation As ECommandBarOrientation
Private m_sToolBarKey As String
Private m_bInDragMode As Boolean

Private m_item() As cDisplayButtonInfo
Private m_sLastToolTip As String

Private m_fntCache As New cFontCache

Private m_cRightShadow As cMenuDropShadow
Private m_cBottomShadow As cMenuDropShadow

Private m_cToolbarImageList As cCommandBarImageList
Private m_cMenuImageList As cCommandBarImageList

Private m_cBack As cAlphaDibSection

Public Event ButtonDropDown(btn As cButton, Cancel As Boolean)
Attribute ButtonDropDown.VB_Description = "Raised when a button is about to show a drop-down object."
Public Event ButtonClick(btn As cButton)
Attribute ButtonClick.VB_Description = "Raised when a button is clicked."
Public Event BeforeShowMenu(Bar As cCommandBar)
Attribute BeforeShowMenu.VB_Description = "Raised before a menu is about to be shown."
Public Event AfterShowMenu(Bar As cCommandBar)
Attribute AfterShowMenu.VB_Description = "Raised when a menu has just been closed."
Public Event RequestNewInstance(ctl As Object)
Attribute RequestNewInstance.VB_Description = "Raised when the control requires a new instance to display a menu."
Public Event Resize()
Attribute Resize.VB_Description = "Raised when the size of the toolbar changes."
Public Event RightClick(btn As cButton, ByVal x As Long, ByVal y As Long)
Attribute RightClick.VB_Description = "Raised when the user right clicks on the toolbar or menu, or an item within it."

Implements ISubclass

'/////////////////////////Add!!
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
Private trans As Long
Private od As Boolean

Private Const WS_POPUP = &H80000000
Private Const SS_OWNERDRAW = &HD&

Private Declare Function CreateWindowEX Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function UpdateLayeredWindow Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal hdcDst As Long, _
    pptDst As Any, _
    psize As Any, _
    ByVal hdcSrc As Long, _
    pptSrc As Any, _
    ByVal crKey As Long, _
    pblend As Any, _
    ByVal dwFlags As Long) As Long

Public Event DrawMenuItem(cDP As cDrawButtonParams, btn As cButton, ByVal btnStyle As EButtonStyle, ByVal ShortcutText As String, DoDefaultDraw As Boolean)
Public Event DrawButton(cDP As cDrawButtonParams, btn As cButton, ByVal btnStyle As EButtonStyle, DoDefaultDraw As Boolean)
Public Event DrawMenuBackground(ByVal hDC As Long, ByVal Width As Long, ByVal Height As Long, Cancel As Boolean)
Public Event DrawToolbarBackground(ByVal hDC As Long, ByVal Width As Long, ByVal Height As Long, ByVal IsMainMenu As Boolean, Cancel As Boolean)

Private m_cCache As New cAlphaDibSection

Public Property Get Transparency() As Long
Transparency = trans
End Property

Public Property Let Transparency(ByVal n As Long)
trans = n
PropertyChanged "Transparency"
End Property

Public Property Get OwnerDraw() As Boolean
Attribute OwnerDraw.VB_ProcData.VB_Invoke_Property = "ppCmdGeneral"
OwnerDraw = od
'Debug.Assert Not od
End Property

Public Property Let OwnerDraw(ByVal b As Boolean)
od = b
PropertyChanged "OwnerDraw"
fPaint
End Property

Public Property Get MenuText() As String
MenuText = globalMenuText
End Property

Public Property Let MenuText(ByVal s As String)
globalMenuText = s
PropertyChanged "MenuText"
End Property

Friend Function fDrawMenu(cDP As cDrawButtonParams, btn As cButton, ByVal st As Long, ByVal s As String) As Boolean
Dim b As Boolean
RaiseEvent DrawMenuItem(cDP, btn, st, s, b)
fDrawMenu = b
End Function

Friend Function fDrawBtn(cDP As cDrawButtonParams, btn As cButton, ByVal st As Long) As Boolean
Dim b As Boolean
RaiseEvent DrawButton(cDP, btn, st, b)
fDrawBtn = b
End Function

'////////////////////////////End add

Public Property Get CustomColor(ByVal eColor As ECustomColors) As OLE_COLOR
Attribute CustomColor.VB_Description = "Gets/sets one of the colours used to draw all toolbars in the project."
   CustomColor = mCommandBarColours.CustomColor(eColor)
End Property
Public Property Let CustomColor(ByVal eColor As ECustomColors, ByVal oColor As OLE_COLOR)
   If Not (mCommandBarColours.CustomColor(eColor) = oColor) Then
      mCommandBarColours.CustomColor(eColor) = oColor
      fPaint
   End If
End Property
Public Property Get StyleColor(ByVal eColor As ECustomColors) As OLE_COLOR
Attribute StyleColor.VB_Description = "Gets the colour used for a particular element for the selected Style."
   StyleColor = mCommandBarColours.StyleColor(eColor)
End Property
Public Property Get UseStyleColor(ByVal eColor As ECustomColors) As Boolean
Attribute UseStyleColor.VB_Description = "Gets/sets whether to use the standard style colour for an element."
   UseStyleColor = mCommandBarColours.UseStyleColor(eColor)
End Property
Public Property Let UseStyleColor(ByVal eColor As ECustomColors, ByVal bState As Boolean)
   If Not (UseStyleColor(eColor) = bState) Then
      UseStyleColor(eColor) = bState
      fPaint
   End If
End Property

Public Property Get BackgroundImage() As IPicture
Attribute BackgroundImage.VB_Description = "Gets/sets a picture to tile behind this control's toolbar."
   If Not (m_cBack Is Nothing) Then
      Set BackgroundImage = m_cBack.Picture
   End If
End Property
Public Property Let BackgroundImage(pic As IPicture)
   pSetBackgroundImage pic
End Property
Public Property Set BackgroundImage(pic As IPicture)
   pSetBackgroundImage pic
End Property
Private Sub pSetBackgroundImage(pic As IPicture)
   If (pic Is Nothing) Then
      Set m_cBack = Nothing
   Else
      Set m_cBack = New cAlphaDibSection
      m_cBack.CreateFromPicture pic
   End If
   fPaint
   
End Sub
Public Sub AdjustBackgroundImage( _
      Optional ByVal newHue As Long = -1, _
      Optional ByVal newSaturation As Long = -1, _
      Optional ByVal fLuminanceAdjustPercent As Single = 0 _
   )
Attribute AdjustBackgroundImage.VB_Description = "Adjusts the hue, luminance or saturation of the background image assigned to this toolbar."
   If Not (m_cBack Is Nothing) Then
      m_cBack.AdjustHLS newHue, newSaturation, fLuminanceAdjustPercent
      fPaint
   End If
End Sub

Public Function AdjustImage( _
      ByVal picIn As IPicture, _
      Optional ByVal newHue As Long = -1, _
      Optional ByVal newSaturation As Long = -1, _
      Optional ByVal fLuminanceAdjustPercent As Single = 0 _
   ) As IPicture
Attribute AdjustImage.VB_Description = "Adjusts the hue, luminance or saturation of a StdPicture object."
   Dim c As New cAlphaDibSection
   c.CreateFromPicture picIn
   If (newHue > -1) And (newSaturation > -1) Then
      c.AdjustHLS newHue, newSaturation, fLuminanceAdjustPercent
   End If
   Set AdjustImage = c.Picture
End Function

Public Property Get MainMenu() As Boolean
Attribute MainMenu.VB_Description = "Gets/sets whether this control should be regarded as the main menu for its owner form."
Attribute MainMenu.VB_ProcData.VB_Invoke_Property = "ppCmdGeneral"
   MainMenu = m_bMainMenu
End Property
Public Property Let MainMenu(ByVal bState As Boolean)
   If Not (m_bMainMenu = bState) Then
      m_bMainMenu = bState
      PropertyChanged "MainMenu"
   End If
End Property

Public Property Get ButtonTextPosition() As ECommandBarButtonTextPosition
Attribute ButtonTextPosition.VB_Description = "Gets/sets the position of the text in buttons shown in this toolbar."
   ButtonTextPosition = m_eButtonPosition
End Property
Public Property Let ButtonTextPosition(ByVal ePosition As ECommandBarButtonTextPosition)
   If Not (m_eButtonPosition = ePosition) Then
      m_eButtonPosition = ePosition
      fResize
      PropertyChanged "ButtonTextPosition"
   End If
End Property

Friend Property Get hWndParent() As Long
   Debug.Print "Parent:", Hex(m_hWndParent)
   hWndParent = m_hWndParent
End Property

Friend Function NewInstance() As vbalCommandBar
   '
   Dim ctl As vbalCommandBar
   RaiseEvent RequestNewInstance(ctl)
   Set NewInstance = ctl
   '
End Function

Friend Sub fSetAsMenu()
   m_bPopup = True
   If Not (m_cMenuImageList Is Nothing) Then
      m_cMenuImageList.DisabledColor = IconDisabledColor
   End If
   m_eOrientation = eTop
   Enabled = True
End Sub

Friend Property Get fIsSetAsMenu() As Boolean
   fIsSetAsMenu = m_bPopup
End Property

Friend Sub fShowMenuShadow()
Dim tR As RECT
   
   GetWindowRect m_hWnd, tR
   Set m_cRightShadow = New cMenuDropShadow
   With m_cRightShadow
      .ShadowType = ERightShadow
      .Initialise tR.Right, tR.Top, .ShadowSize, tR.Bottom - tR.Top, m_hWnd
      .ShadowColor = MenuShadowColor
      .Create
   End With
   
   Set m_cBottomShadow = New cMenuDropShadow
   With m_cBottomShadow
      .ShadowType = EBottomShadow
      .Initialise tR.Left, tR.Bottom, tR.Right - tR.Left, .ShadowSize, m_hWnd
      .ShadowColor = MenuShadowColor
      .Create
   End With
   
End Sub

Public Property Get hWnd() As Long
Attribute hWnd.VB_Description = "Gets the Window handle for this control."
   hWnd = m_hWnd
End Property

Public Sub ClientCoordinatesToScreen( _
      ByRef xPixels As Long, _
      ByRef yPixels As Long, _
      Optional ByVal hWndClient As Long = 0 _
   )
Attribute ClientCoordinatesToScreen.VB_Description = "Converts x,y coordinates in pixels relative to a particular window to screen coordinates.  If no window is specified the control's window is used."
Dim tP As POINTAPI
   tP.x = xPixels
   tP.y = yPixels
   If (hWndClient = 0) Then
      hWndClient = m_hWnd
   End If
   ClientToScreen hWndClient, tP
   xPixels = tP.x
   yPixels = tP.y
End Sub

Public Sub ScreenCoordinatesToClient( _
      ByRef xPixels As Long, _
      ByRef yPixels As Long, _
      Optional ByVal hWndClient As Long = 0 _
   )
Attribute ScreenCoordinatesToClient.VB_Description = "Converts x,y coordinates in pixels relative to the screen to client coordinates in pixels.  If no window is specified the control's window is used."
Dim tP As POINTAPI
   tP.x = xPixels
   tP.y = yPixels
   If (hWndClient = 0) Then
      hWndClient = m_hWnd
   End If
   ScreenToClient hWndClient, tP
   xPixels = tP.x
   yPixels = tP.y
End Sub

Public Sub ShowPopupMenu( _
      ByVal x As Long, _
      ByVal y As Long, _
      ByVal Bar As cCommandBar _
   )
Attribute ShowPopupMenu.VB_Description = "Shows the specified CommandBar at the specified position. The position is in pixels, relative to the screen."
Dim barDropDownInt As cCommandBarInt
   
   Set barDropDownInt = mCommandBars.BarItem(Bar.Key)
   pShowDropDownBar barDropDownInt, 0, x, y, , True
   
End Sub

Public Sub ShowChevronMenu( _
      ByVal x As Long, _
      ByVal y As Long _
   )
Attribute ShowChevronMenu.VB_Description = "Shows the chevron menu for this toolbar at the specified location."
Dim myBar As cCommandBarInt
Dim iBtn As Long
Dim barWork As cCommandBarInt
Dim btnWork As cButtonInt
Dim btnEquiv As cButtonInt
Dim barChevron As cCommandBarInt
Dim barAddOrRemove As cCommandBarInt
Dim btnAddOrRemoveSep As cButtonInt

   If (Len(m_sToolBarKey) > 0) Then
      Set myBar = mCommandBars.BarItem(m_sToolBarKey)
      If Not (myBar Is Nothing) Then
   
         Set btnWork = mCommandBars.ButtonItem("CHEVRON:ADDORREMOVEBAR")
         btnWork.Caption = myBar.Title
         
         Set barChevron = mCommandBars.BarItem("CHEVRON")

         Set barAddOrRemove = mCommandBars.BarItem("CHEVRON:ADDORREMOVE")
         Set btnAddOrRemoveSep = mCommandBars.ButtonItem("CHEVRON:ADDORREMOVE:SEPARATOR")
         
         Do While barAddOrRemove.count > 0
            If (barAddOrRemove.Item(1).Key = btnAddOrRemoveSep.Key) Then
               Exit Do
            Else
               barAddOrRemove.Remove barAddOrRemove.Item(1)
            End If
         Loop
         
         For iBtn = 1 To myBar.count
            Set btnWork = myBar.Item(iBtn)
            If Not (btnWork.Style = eSeparator) Then
               btnWork.VisibleCheck = IIf(btnWork.Visible, vbChecked, vbUnchecked)
               barAddOrRemove.InsertBefore btnWork, btnAddOrRemoveSep
               If (m_item(iBtn).Hidden) Then
                  
               End If
            End If
         Next iBtn
               
         Dim ctlChevron As vbalCommandBar
         pShowDropDownBar barChevron, 0, x, y
         
      End If
   End If
End Sub

Public Property Get Orientation() As ECommandBarOrientation
Attribute Orientation.VB_Description = "Gets/sets the orientation to display this toolbar in."
   Orientation = m_eOrientation
End Property
Public Property Let Orientation(ByVal EOrientation As ECommandBarOrientation)
   If Not (EOrientation = m_eOrientation) Then
      If (m_bPopup) Then
         ' TODO possibly should raise an error here?
      Else
         m_eOrientation = EOrientation
      End If
      fResize
      fPaint
      PropertyChanged "Orientation"
   End If
End Property

Public Property Let ToolbarImageList( _
        ByRef vImageList As Variant _
    )
Attribute ToolbarImageList.VB_Description = "Associates an ImageList with the control.  The ImageList may either be a Microsoft Common Controls object or a handle to a ComCtl32 ImageList."
    m_cToolbarImageList.InitialiseFromVariant vImageList
    fResize
End Property
Public Property Let MenuImageList( _
      ByRef vImageList As Variant _
   )
Attribute MenuImageList.VB_Description = "Gets/sets the ImageList to be used for icons in drop-down menus shown from this toolbar."
   m_cMenuImageList.InitialiseFromVariant vImageList
   fResize
End Property

Friend Sub fSetImageListAndFont( _
      cToolbarImageList As cCommandBarImageList, _
      cMenuImageList As cCommandBarImageList, _
      fnt As IFont _
   )
   
   Font = fnt
   m_cToolbarImageList.InitialiseFromInstance cToolbarImageList
   m_cMenuImageList.InitialiseFromInstance cMenuImageList
   
End Sub
Public Property Get Redraw() As Boolean
Attribute Redraw.VB_Description = "Gets/sets whether the control redraws or not."
   Redraw = m_bRedraw
End Property
Public Property Let Redraw(ByVal bState As Boolean)
   If Not (m_bRedraw = bState) Then
      m_bRedraw = bState
      If (m_bRedraw) Then
         fPaint
      End If
      PropertyChanged "Redraw"
   End If
End Property
Public Property Get Font() As IFont
Attribute Font.VB_Description = "Gets/sets the font used to draw the control.  The font should be a True-Type font such as Tahoma or Arial."
   Set Font = UserControl.Font
End Property
Public Property Let Font(ifnt As IFont)
   Set UserControl.Font = ifnt
   fResize
   PropertyChanged "Font"
End Property
Public Property Set Font(ifnt As IFont)
   Set UserControl.Font = ifnt
   fResize
   PropertyChanged "Font"
End Property

Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Gets/sets whether the control is enabled."
   Enabled = m_bEnabled
End Property
Public Property Let Enabled(ByVal bEnabled As Boolean)
   m_bEnabled = bEnabled
   UserControl.Enabled = m_bEnabled
   PropertyChanged "Enabled"
End Property

Public Property Get HideInfrequentlyUsed() As Boolean
Attribute HideInfrequentlyUsed.VB_Description = "Gets/sets whether infrequently used menu items are hidden or not."
   HideInfrequentlyUsed = mCommandBars.HideInfrequentlyUsed
End Property
Public Property Let HideInfrequentlyUsed(ByVal bState As Boolean)
   mCommandBars.HideInfrequentlyUsed = bState
   PropertyChanged "HideInfrequentlyUsed"
End Property

Public Property Get Style() As EToolBarStyle
Attribute Style.VB_Description = "Gets/sets the global style used to render all toolbars and menus in this project."
   Style = mCommandBarColours.Style
End Property
Public Property Let Style(ByVal eStyle As EToolBarStyle)
   If Not (mCommandBarColours.Style = eStyle) Then
      mCommandBarColours.Style = eStyle
      PropertyChanged "Style"
   End If
End Property

Public Property Get IdealSize() As Long
Attribute IdealSize.VB_Description = "Gets the ideal size in pixels of this toolbar."
   '
   '
End Property

Public Property Get Toolbar() As cCommandBar
Attribute Toolbar.VB_Description = "Gets/sets the CommandBar object to be displayed in this control instance."
   If Len(m_sToolBarKey) > 0 Then
      Dim c As New cCommandBar
      c.fInit m_hWnd, m_sToolBarKey
      Set Toolbar = c
   End If
End Property
Public Property Let Toolbar(Bar As cCommandBar)
   pSetToolbar Bar
End Property
Public Property Set Toolbar(Bar As cCommandBar)
   pSetToolbar Bar
   
End Property
Private Sub pSetToolbar(Bar As cCommandBar)
            
   fInUse = True
   
   Dim barInt As cCommandBarInt
   If Len(m_sToolBarKey) > 0 Then
      Set barInt = mCommandBars.BarItem(m_sToolBarKey)
      If Not barInt Is Nothing Then
         barInt.ReleaseRef m_hWnd
      End If
   End If

   If (Bar Is Nothing) Then
      pUnSubclass
      m_sToolBarKey = ""
      fResize
      fPaint
   Else
      pSubClass
      m_sToolBarKey = Bar.Key
      Set barInt = mCommandBars.BarItem(m_sToolBarKey)
      barInt.AddRefhWnd m_hWnd, m_hWndParent
      If Not (m_bPopup) Then
         Dim i As Long
         Dim ctl As Object
         For i = 1 To barInt.count
            Set ctl = barInt.Item(i).PanelControl
            If Not ctl Is Nothing Then
               On Error Resume Next
               Set ctl.Container = UserControl.Extender
               On Error GoTo 0
            End If
         Next i
      End If
      m_bPopupVisibleChecks = (m_sToolBarKey = "CHEVRON:ADDORREMOVE")
      fResize
      fPaint
   End If
End Sub

Public Property Get CommandBars() As cCommandBars
Attribute CommandBars.VB_Description = "Gets the collection of all CommandBar objects.  CommandBar objects are global to the project, not a specific control."
   Dim c As New cCommandBars
   c.fInit m_hWnd
   Set CommandBars = c
End Property
Public Property Get Buttons() As cButtons
Attribute Buttons.VB_Description = "Gets the collection of all Button objects.  Button objects are global to the project, not a specific control."
   Dim c As New cButtons
   c.fInit m_hWnd
   Set Buttons = c
End Property


Friend Property Get Popup() As Boolean
   Popup = m_bPopup
End Property

Friend Function BarCount() As Long
   If Not (m_hWnd = 0) Then
      BarCount = mCommandBars.BarCount
   End If
End Function
Friend Function BarItem(ByVal index As Variant) As cCommandBar
   If Not (m_hWnd = 0) Then
      Dim barInt As cCommandBarInt
      Set barInt = mCommandBars.BarItem(index)
      If Not (barInt Is Nothing) Then
         Dim c As New cCommandBar
         c.fInit m_hWnd, barInt.Key
         Set BarItem = c
      End If
   End If
End Function
Friend Property Get BarTitle(ByVal sKey As String) As String
   If Not (m_hWnd = 0) Then
      Dim intBar As cCommandBarInt
      Set intBar = mCommandBars.BarItem(sKey)
      If Not (intBar Is Nothing) Then
         BarTitle = intBar.Title
      End If
   End If
End Property
Friend Property Let BarTitle(ByVal sKey As String, ByVal sTitle As String)
   If Not (m_hWnd = 0) Then
      Dim intBar As cCommandBarInt
      Set intBar = mCommandBars.BarItem(sKey)
      If Not (intBar Is Nothing) Then
         intBar.Title = sTitle
      End If
   End If
End Property
Friend Sub BarRemove(ByVal sKey As String)
   If Not (m_hWnd = 0) Then
      mCommandBars.BarRemove sKey
   End If
End Sub
Friend Function BarAdd(ByVal sKey As String, ByVal sTitle As String) As cCommandBar
Dim barInt As cCommandBarInt
   Set barInt = mCommandBars.BarAdd(sKey)
   If Not (barInt Is Nothing) Then
      If Len(sTitle) > 0 Then
         barInt.Title = sTitle
      End If
      Dim c As New cCommandBar
      c.fInit m_hWnd, sKey
      Set BarAdd = c
   End If
End Function

Friend Property Get BarButtonCount(ByVal sKey As String) As Long
Dim barInt As cCommandBarInt
   Set barInt = mCommandBars.BarItem(sKey)
   If Not (barInt Is Nothing) Then
      BarButtonCount = barInt.count
   End If
End Property
Friend Sub BarButtonClear(ByVal sKey As String)
Dim barInt As cCommandBarInt
   Set barInt = mCommandBars.BarItem(sKey)
   If Not (barInt Is Nothing) Then
      barInt.Clear
   End If
End Sub
Friend Function BarButtonCollection(ByVal sKey As String) As cCommandBarButtons
Dim barInt As cCommandBarInt
   Set barInt = mCommandBars.BarItem(sKey)
   If Not (barInt Is Nothing) Then
      Dim c As New cCommandBarButtons
      c.fInit m_hWnd, sKey
      Set BarButtonCollection = c
   End If
End Function
Friend Sub BarButtonRemove(ByVal sBarKey As String, ByVal sButtonKey As String)
Dim barInt As cCommandBarInt
Dim btnInt As cButtonInt
   Set barInt = mCommandBars.BarItem(sBarKey)
   If Not (barInt Is Nothing) Then
      Set btnInt = mCommandBars.ButtonItem(sButtonKey)
      barInt.Remove btnInt
   End If
End Sub
Friend Sub BarButtonAdd(ByVal sBarKey As String, btn As cButton)
Dim btnInt As cButtonInt
Dim barInt As cCommandBarInt
   Set barInt = mCommandBars.BarItem(sBarKey)
   If Not (barInt Is Nothing) Then
      Set btnInt = mCommandBars.ButtonItem(btn.Key)
      If Not (btnInt Is Nothing) Then
         barInt.Add btnInt
      End If
   End If
End Sub
Friend Sub BarButtonInsertAfter(ByVal sBarKey As String, btn As cButton, btnAfter As cButton)
Dim btnInt As cButtonInt
Dim btnAfterInt As cButtonInt
Dim barInt As cCommandBarInt
   Set barInt = mCommandBars.BarItem(sBarKey)
   If Not (barInt Is Nothing) Then
      Set btnInt = mCommandBars.ButtonItem(btn.Key)
      If Not (btnInt Is Nothing) Then
         Set btnAfterInt = mCommandBars.ButtonItem(btnAfter.Key)
         If Not (btnAfterInt Is Nothing) Then
            barInt.InsertAfter btnInt, btnAfterInt
         End If
      End If
   End If
End Sub
Friend Sub BarButtonInsertBefore(ByVal sBarKey As String, btn As cButton, btnBefore As cButton)
Dim btnInt As cButtonInt
Dim btnBeforeInt As cButtonInt
Dim barInt As cCommandBarInt
   Set barInt = mCommandBars.BarItem(sBarKey)
   If Not (barInt Is Nothing) Then
      Set btnInt = mCommandBars.ButtonItem(btn.Key)
      If Not (btnInt Is Nothing) Then
         Set btnBeforeInt = mCommandBars.ButtonItem(btnBefore.Key)
         If Not (btnBeforeInt Is Nothing) Then
            barInt.InsertBefore btnInt, btnBeforeInt
         End If
      End If
   End If
End Sub
Friend Property Get BarButton(ByVal sBarKey As String, ByVal index As Variant) As cButton
Dim btnInt As cButtonInt
Dim barInt As cCommandBarInt
   Set barInt = mCommandBars.BarItem(sBarKey)
   If Not (barInt Is Nothing) Then
      Set btnInt = barInt.Item(index)
      If Not (btnInt Is Nothing) Then
         Dim c As New cButton
         c.fInit m_hWnd, btnInt.Key
         Set BarButton = c
      End If
   End If
End Property

Friend Function ButtonCount() As Long
   If Not (m_hWnd = 0) Then
      ButtonCount = mCommandBars.ButtonCount
   End If
End Function
Friend Function ButtonIndex(btn As cButtonInt) As Long
   If Not (m_hWnd = 0) Then
      If Len(m_sToolBarKey) > 0 Then
         Dim Bar As cCommandBarInt
         Set Bar = mCommandBars.BarItem(m_sToolBarKey)
         If Not (Bar Is Nothing) Then
            Dim i As Long
            For i = 1 To Bar.count
               If (Bar.Item(i) Is btn) Then
                  ButtonIndex = i
                  Exit For
               End If
            Next i
         End If
      End If
   End If
End Function
Friend Function ButtonItem(ByVal index As Variant) As cButton
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(index)
      If Not (btnInt Is Nothing) Then
         Dim c As New cButton
         c.fInit m_hWnd, btnInt.Key
         Set ButtonItem = c
      End If
   End If
End Function
Friend Sub ButtonRemove(ByVal sKey As String)
   If Not (m_hWnd = 0) Then
      mCommandBars.ButtonRemove sKey
   End If
End Sub
Friend Function ButtonAdd( _
      ByVal sKey As String, _
      Optional ByVal iIcon As Long = -1, _
      Optional ByVal sCaption As String = "", _
      Optional ByVal eStyle As EButtonStyle = eNormal, _
      Optional ByVal sToolTip As String = "", _
      Optional ByVal vShortcutKey As Integer = 0, _
      Optional ByVal eShortcutModifier As ShiftConstants = vbCtrlMask _
   ) As cButton
Dim btnInt As cButtonInt
   Set btnInt = mCommandBars.ButtonAdd(sKey)
   If Not (btnInt Is Nothing) Then
      If (iIcon <> -1) Then
         btnInt.IconIndex = iIcon
      End If
      If Len(sCaption) > 0 Then
         btnInt.Caption = sCaption
      End If
      If (eStyle <> eNormal) Then
         btnInt.Style = eStyle
      End If
      btnInt.ShortcutKey = vShortcutKey
      btnInt.ShortcutModifiers = eShortcutModifier
      btnInt.ToolTip = sToolTip
      Dim c As New cButton
      c.fInit m_hWnd, sKey
      Set ButtonAdd = c
   End If
End Function
Friend Property Get ButtonCaption(ByVal sKey As String) As String
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         ButtonCaption = btnInt.Caption
      End If
   End If
End Property
Friend Property Let ButtonCaption(ByVal sKey As String, ByVal sCaption As String)
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         btnInt.Caption = sCaption
      End If
   End If
End Property
Friend Property Get ButtonShortcutKey(ByVal sKey As String) As Integer
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         ButtonShortcutKey = btnInt.ShortcutKey
      End If
   End If
End Property
Friend Property Let ButtonShortcutKey(ByVal sKey As String, ByVal vShortcutKey As Integer)
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         btnInt.ShortcutKey = vShortcutKey
      End If
   End If
End Property
Friend Property Get ButtonShortcutModifiers(ByVal sKey As String) As ShiftConstants
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         ButtonShortcutModifiers = btnInt.ShortcutModifiers
      End If
   End If
End Property
Friend Property Let ButtonShortcutModifiers(ByVal sKey As String, ByVal eShortcutModifiers As ShiftConstants)
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         btnInt.ShortcutModifiers = eShortcutModifiers
      End If
   End If
End Property
Friend Property Get ButtonToolTip(ByVal sKey As String) As String
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         ButtonToolTip = btnInt.ToolTip
      End If
   End If
End Property
Friend Property Let ButtonToolTip(ByVal sKey As String, ByVal sToolTip As String)
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         btnInt.ToolTip = sToolTip
      End If
   End If
End Property
Friend Property Get ButtonColourBox(ByVal sKey As String) As OLE_COLOR
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         ButtonColourBox = btnInt.colourBox
      End If
   End If
End Property
Friend Property Let ButtonColourBox(ByVal sKey As String, ByVal oColor As OLE_COLOR)
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         btnInt.colourBox = oColor
      End If
   End If
End Property
Friend Property Get ButtonIconIndex(ByVal sKey As String) As Long
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         ButtonIconIndex = btnInt.IconIndex
      End If
   End If
End Property
Friend Property Let ButtonIconIndex(ByVal sKey As String, ByVal lIconIndex As Long)
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         btnInt.IconIndex = lIconIndex
      End If
   End If
End Property
Friend Property Get ButtonPanelWidth(ByVal sKey As String) As Long
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         ButtonPanelWidth = btnInt.PanelWidth
      End If
   End If
End Property
Friend Property Let ButtonPanelWidth(ByVal sKey As String, ByVal lPanelWidth As Long)
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         btnInt.PanelWidth = lPanelWidth
      End If
   End If
End Property
Friend Property Get ButtonPanelControl(ByVal sKey As String) As Object
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         Set ButtonPanelControl = btnInt.PanelControl
      End If
   End If
End Property
Friend Property Let ButtonPanelControl(ByVal sKey As String, ctl As Object)
   pSetButtonPanelControl sKey, ctl
End Property
Friend Property Set ButtonPanelControl(ByVal sKey As String, ctl As Object)
   pSetButtonPanelControl sKey, ctl
End Property
Private Sub pSetButtonPanelControl(ByVal sKey As String, ctl As Object)
   If Not (m_hWnd = 0) Then
      If Not (m_bPopup) Then
         Dim btnInt As cButtonInt
         Set btnInt = mCommandBars.ButtonItem(sKey)
         If Not (btnInt Is Nothing) Then
            Dim ctlPrev As Object
            Set ctlPrev = btnInt.PanelControl
            If Not (ctlPrev Is Nothing) Then
               On Error Resume Next
               ctlPrev.Visible = False
               On Error GoTo 0
            End If
            If (ctl Is Nothing) Then
               Set btnInt.PanelControl = Nothing
            Else
               On Error Resume Next
               Set ctl.Container = UserControl.Extender
               ctl.Visible = False
               On Error GoTo 0
               Set btnInt.PanelControl = ctl
            End If
         End If
      End If
   End If

End Sub
Friend Property Get ButtonEnabled(ByVal sKey As String) As Boolean
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         ButtonEnabled = btnInt.Enabled
      End If
   End If
End Property
Friend Property Let ButtonEnabled(ByVal sKey As String, ByVal bEnabled As Boolean)
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         btnInt.Enabled = bEnabled
      End If
   End If
End Property
Friend Property Get ButtonLocked(ByVal sKey As String) As Boolean
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         ButtonLocked = btnInt.Locked
      End If
   End If
End Property
Friend Property Let ButtonLocked(ByVal sKey As String, ByVal bLocked As Boolean)
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         btnInt.Locked = bLocked
      End If
   End If
End Property
Friend Property Get ButtonVisible(ByVal sKey As String) As Boolean
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         ButtonVisible = btnInt.Visible
      End If
   End If
End Property
Friend Property Let ButtonVisible(ByVal sKey As String, ByVal bVisible As Boolean)
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         btnInt.Visible = bVisible
      End If
   End If
End Property
Friend Property Get ButtonChecked(ByVal sKey As String) As Boolean
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         ButtonChecked = btnInt.Checked
      End If
   End If
End Property
Friend Property Let ButtonChecked(ByVal sKey As String, ByVal bChecked As Boolean)
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         btnInt.Checked = bChecked
      End If
   End If
End Property
Friend Property Get ButtonShowCaptionInToolbar(ByVal sKey As String) As Boolean
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         ButtonShowCaptionInToolbar = btnInt.ShowCaptionInToolbar
      End If
   End If
End Property
Friend Property Let ButtonShowCaptionInToolbar(ByVal sKey As String, ByVal bShowCaptionInToolbar As Boolean)
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         btnInt.ShowCaptionInToolbar = bShowCaptionInToolbar
      End If
   End If
End Property
Friend Property Get ButtonShowDropDownInToolbar(ByVal sKey As String) As Boolean
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         ButtonShowDropDownInToolbar = btnInt.ShowDropDownInToolbar
      End If
   End If
End Property
Friend Property Let ButtonShowDropDownInToolbar(ByVal sKey As String, ByVal bShowDropDownInToolbar As Boolean)
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         btnInt.ShowDropDownInToolbar = bShowDropDownInToolbar
      End If
   End If
End Property
Friend Property Get ButtonStyle(ByVal sKey As String) As EButtonStyle
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         ButtonStyle = btnInt.Style
      End If
   End If
End Property
Friend Property Let ButtonStyle(ByVal sKey As String, ByVal eStyle As EButtonStyle)
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         btnInt.Style = eStyle
      End If
   End If
End Property
Friend Property Get ButtonBar(ByVal sKey As String) As cCommandBar
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         Dim barInt As cCommandBarInt
         Set barInt = btnInt.Bar
         If Not (barInt Is Nothing) Then
            Dim c As New cCommandBar
            c.fInit m_hWnd, barInt.Key
            Set ButtonBar = c
         End If
      End If
   End If
End Property
Friend Sub ButtonSetBar(ByVal sKey As String, cmdBar As cCommandBar)
   If Not (m_hWnd = 0) Then
      Dim btnInt As cButtonInt
      Dim barInt As cCommandBarInt
      Set btnInt = mCommandBars.ButtonItem(sKey)
      If Not (btnInt Is Nothing) Then
         Set barInt = mCommandBars.BarItem(cmdBar.Key)
         If Not (barInt Is Nothing) Then
            btnInt.SetBar barInt
         End If
      End If
   End If
End Sub

Friend Sub ChangeNotification(Bar As cCommandBarInt, ByVal eventType As Long, itm As cButtonInt)
   '
   If StrComp(Bar.Key, m_sToolBarKey) = 0 Then
      If (eventType = CHANGENOTIFICATIONBARCONTENTCHANGE) Or _
         (eventType = CHANGENOTIFICATIONBUTTONSIZECHANGE) Then
         fResize
         If (m_bPopup) Then
            fShowMenuShadow
         End If
         
      End If
      If Not (itm Is Nothing) And _
         (eventType = CHANGENOTIFICATIONBUTTONREDRAW) Or _
         (eventType = CHANGENOTIFICATIONBUTTONCHECKCHANGE) Then
         If (m_bWrappable Or m_bMainMenu) Then
            fPaint
         Else
            fPaintOneButton Bar.IndexOf(itm.Key)
         End If
      Else
         fPaint
      End If
   End If
   '
End Sub

Private Sub prepareDisplayItemArray(barInt As cCommandBarInt)
   If (barInt.count > 0) Then
      Dim i As Long
      ReDim Preserve m_item(1 To barInt.count) As cDisplayButtonInfo
      For i = 1 To barInt.count
         Set m_item(i) = New cDisplayButtonInfo
      Next i
   End If
End Sub

Friend Sub fResize()
   '

   Erase m_item

   If Len(m_sToolBarKey) > 0 Then

      Dim barInt As cCommandBarInt
      Set barInt = mCommandBars.BarItem(m_sToolBarKey)

      If Not (barInt Is Nothing) Then

         prepareDisplayItemArray barInt

         Dim tR As RECT
         GetClientRect m_hWnd, tR

         Dim cMP As New cMeasureButtonParams
         With cMP
            .FontFace = Me.Font.Name
            .FontSize = Me.Font.Size
            .hDC = UserControl.hDC
            .Height = tR.Bottom - tR.Top
            .hFont = plGetHFont()
            .hWnd = m_hWnd
            .RightToLeft = pbRightToLeft()
            .Size = tR.Right - tR.Left
         End With

         If (m_bPopup) Then
            '
            cMP.Orientation = eTop
            cMP.ButtonPosition = m_eButtonPosition
            If m_bPopupVisibleChecks Then
               cMP.SizeStyle = COMMANDBARSIZESTYLEMENUVISIBLECHECK
            Else
               cMP.SizeStyle = COMMANDBARSIZESTYLEMENU
            End If            '
            cMP.Size = cMP.Size - 4
            cMP.IconWidth = m_cMenuImageList.IconWidth
            If (cMP.IconWidth = 0) Then cMP.IconWidth = 8
            cMP.IconHeight = m_cMenuImageList.IconHeight
            If (cMP.IconHeight = 0) Then cMP.IconHeight = 8

            ' we need to calculate the required width & height
            ' of the control:
            Dim menuWidth As Long
            Dim menuHeight As Long
            If (barInt.count > 0) Then
               barInt.CalculateMenuSize cMP, menuWidth, menuHeight, m_item, (cMP.SizeStyle = COMMANDBARSIZESTYLEMENUVISIBLECHECK)
               GetWindowRect m_hWnd, tR
               If (tR.Right - tR.Left = menuWidth) And (tR.Bottom - tR.Top = menuHeight) Then
               Else
                  On Error Resume Next
                  UserControl.Extender.Width = UserControl.Extender.Container.ScaleX(menuWidth, vbPixels, UserControl.Extender.Container.ScaleMode)
                  UserControl.Extender.Height = UserControl.Extender.Container.ScaleX(menuHeight + 2, vbPixels, UserControl.Extender.Container.ScaleMode)
               End If
            End If

            '
         Else
            '
            Dim toolbarWidth As Long
            Dim toolbarHeight As Long

            toolbarWidth = tR.Right - tR.Left
            toolbarHeight = tR.Bottom - tR.Top
            cMP.Orientation = m_eOrientation
            cMP.ButtonPosition = m_eButtonPosition
            cMP.IconHeight = m_cToolbarImageList.IconHeight
            cMP.IconWidth = m_cToolbarImageList.IconWidth

            ' the calculation result depends on whether we're wrappable or not
            If (m_bWrappable) Then
               '

               cMP.SizeStyle = COMMANDBARSIZESTYLETOOLBARWRAPPABLE

               ' Given the current width, what height do we need
               ' to be?

            Else
               '
               If (m_bMainMenu) Then
                  cMP.SizeStyle = COMMANDBARSIZESTYLETOOLBARMENU
               Else
                  cMP.SizeStyle = COMMANDBARSIZESTYLETOOLBAR
               End If

               If (barInt.count > 0) Then

                  barInt.CalculateToolbarSize cMP, toolbarWidth, toolbarHeight, m_item

                  GetWindowRect m_hWnd, tR
                  If (m_eOrientation = eLeft) Or (m_eOrientation = eRight) Then
                     If Not ((tR.Right - tR.Left) = toolbarHeight) Then
                        On Error Resume Next
                        UserControl.Extender.Width = UserControl.Extender.Container.ScaleX(toolbarHeight, vbPixels, UserControl.Extender.Container.ScaleMode)
                     End If
                  Else
                     If Not ((tR.Bottom - tR.Top) = toolbarHeight) Then
                        On Error Resume Next
                        UserControl.Extender.Height = UserControl.Extender.Container.ScaleY(toolbarHeight, vbPixels, UserControl.Extender.Container.ScaleMode)
                     End If
                  End If
               End If

            End If

            '
         End If

         fPaint

      End If
   End If
   '
End Sub
Friend Sub fPaintStyleChanged()
   
   If (m_bPopup) Then
      m_cMenuImageList.DisabledColor = IconDisabledColor
   Else
      m_cToolbarImageList.DisabledColor = ButtonTextDisabledColor
      m_cToolbarImageList.HighlightColor = ButtonTextHotColor
   End If
   fPaint
   
End Sub

Friend Sub fPaint()
   '
   If (m_bRedraw And m_bVisible) Then
   
      Dim lHDC As Long
      Dim tR As RECT
      
      lHDC = UserControl.hDC
      GetClientRect m_hWnd, tR
      
      If (m_bPopup) Then
      
         pPaintMenuBackground lHDC, tR.Left, tR.Top, tR.Right, tR.Bottom, False
         
      Else
         ' paint the background to the bar:
         If Not (m_cBack Is Nothing) Then
            TileArea lHDC, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, m_cBack.hDC, m_cBack.Width, m_cBack.Height, 0
         Else
          '///////////////////Add!
          Dim b As Boolean
          If od Then
           m_cCache.Create tR.Right, tR.Bottom
           RaiseEvent DrawToolbarBackground(m_cCache.hDC, tR.Right, tR.Bottom, m_bMainMenu, b)
          End If
          '////////////////////end
          If b Or Not od Then
            If (m_bMainMenu) Or (GradientColorStart = -1) Then
               UtilDrawBackgroundPortion m_hWnd, m_hWndParent, lHDC, _
                  GradientColorEnd, GradientColorStart, _
                  tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, _
                  True, (Style = eComCtl32)
            Else
               UtilDrawBackground lHDC, _
                  GradientColorStart, GradientColorEnd, _
                  tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, _
                  ((m_eOrientation = eRight) Or (m_eOrientation = eLeft))
            End If
            If od Then BitBlt m_cCache.hDC, 0, 0, tR.Right, tR.Bottom, lHDC, 0, 0, vbSrcCopy
          Else
           m_cCache.PaintPicture lHDC
          End If
          '/////////////////////
         End If
      End If
            
      ' ask the bar to render itself, if any:
      If Len(m_sToolBarKey) > 0 Then
         
         Dim barInt As cCommandBarInt
         Set barInt = mCommandBars.BarItem(m_sToolBarKey)
         '///////////Add!!
         Set barInt.The__owner = Me
         '///////////End
         If Not (barInt Is Nothing) Then
            
            Dim cDP As New cDrawButtonParams
            
            cDP.hWnd = m_hWnd
            cDP.hDC = lHDC
            cDP.FontFace = UserControl.Font.Name
            cDP.FontSize = UserControl.Font.Size
            cDP.hFont = plGetHFont()
            cDP.Enabled = m_bEnabled
            cDP.RightToLeft = pbRightToLeft()
            cDP.ButtonPosition = m_eButtonPosition
            
            If (m_bPopup) Then
               Set cDP.ImageList = m_cMenuImageList
               cDP.Orientation = eTop
               If (m_bPopupVisibleChecks) Then
                  cDP.SizeStyle = COMMANDBARSIZESTYLEMENUVISIBLECHECK
               Else
                  cDP.SizeStyle = COMMANDBARSIZESTYLEMENU
               End If
            Else
               Set cDP.ImageList = m_cToolbarImageList
               cDP.Orientation = m_eOrientation
               If (cDP.Orientation = eLeft) Or (cDP.Orientation = eRight) Then
                  cDP.ToolbarSize = tR.Right - tR.Left
               Else
                  cDP.ToolbarSize = tR.Bottom - tR.Top
               End If
               If (m_bWrappable) Then
                  cDP.SizeStyle = COMMANDBARSIZESTYLETOOLBARWRAPPABLE
               ElseIf (m_bMainMenu) Then
                  cDP.SizeStyle = COMMANDBARSIZESTYLETOOLBARMENU
               Else
                  cDP.SizeStyle = COMMANDBARSIZESTYLETOOLBAR
               End If
            End If
            barInt.Draw cDP, m_item
            
         End If
      End If
      
      UserControl.Refresh
   
   End If
   '
End Sub

Private Sub pPaintMenuBackground( _
      ByVal lHDC As Long, _
      ByVal lLeft As Long, ByVal lTop As Long, _
      ByVal lRight As Long, ByVal lBottom As Long, _
      ByVal bForOneItem As Boolean _
   )
'//////////////////Add!!
Dim b As Boolean
If od Then
 If bForOneItem Then
  BitBlt lHDC, lLeft, lTop, lRight - lLeft, lBottom - lTop, m_cCache.hDC, lLeft, lTop, vbSrcCopy
  Exit Sub
 Else
  m_cCache.Create lRight, lBottom
  RaiseEvent DrawMenuBackground(m_cCache.hDC, lRight, lBottom, b)
  If Not b Then
   m_cCache.PaintPicture lHDC
   Exit Sub
  End If
 End If
End If
'//////////////////End
   Dim lSideBarWidth As Long
   lSideBarWidth = m_cMenuImageList.IconWidth + 8
   
   If (m_bPopupVisibleChecks) Then
      ' Add the extra side bar width
      lSideBarWidth = lSideBarWidth + m_cMenuImageList.IconWidth + 2
   End If
   
   UtilDrawBackground lHDC, _
      MenuBackgroundColorStart, MenuBackgroundColorEnd, _
      lLeft, lTop, lRight - lLeft, lBottom - lTop
      
   Dim tR As RECT
   GetClientRect m_hWnd, tR
   UtilDrawBorderRectangle lHDC, MenuBorderColor, _
      tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, False
   
   Dim tPStart As POINTAPI
   Dim tPEnd As POINTAPI
   Dim hPen As Long
   Select Case m_eMenuPopoutDirection
   Case eLeft, eRight
      tPStart.y = m_lMenuPopoutStart + 1
      ScreenToClient m_hWnd, tPStart
      tPEnd.y = m_lMenuPopoutStart + m_lMenuPopoutExtent - 1
      ScreenToClient m_hWnd, tPEnd
      If (m_eMenuPopoutDirection = eLeft) Then
         tPStart.x = tR.Left
         tPEnd.x = tR.Left
      Else
         tPStart.x = tR.Right - 1
         tPEnd.x = tR.Right - 1
      End If
      hPen = CreatePen(PS_SOLID, 1, MenuBackgroundColorStart)
   Case eTop, eBottom
      tPStart.x = m_lMenuPopoutStart + 1
      ScreenToClient m_hWnd, tPStart
      tPEnd.x = m_lMenuPopoutStart + m_lMenuPopoutExtent - 1
      ScreenToClient m_hWnd, tPEnd
      If (m_eMenuPopoutDirection = eTop) Then
         tPStart.y = tR.Top
         tPEnd.y = tR.Top
      Else
         tPStart.y = tR.Bottom - 1
         tPEnd.y = tR.Bottom - 1
      End If
      hPen = CreatePen(PS_SOLID, 1, MenuBackgroundColorStart)
   End Select
   
   If Not (hPen = 0) Then
      Dim hPenOld As Long
      Dim tJunk As POINTAPI
      hPenOld = SelectObject(lHDC, hPen)
      MoveToEx lHDC, tPStart.x, tPStart.y, tJunk
      LineTo lHDC, tPEnd.x, tPEnd.y
      SelectObject lHDC, hPenOld
      DeleteObject hPen
   End If
   
   lLeft = lLeft + 1
   lRight = lRight - 2
   If Not (bForOneItem) Then
      lTop = lTop + 2
      lBottom = lBottom - 2
   ElseIf lTop = 1 Then
      lTop = lTop + 1
   End If
      
   ' paint the side bar:
   If (pbRightToLeft()) Then
      UtilDrawBackground lHDC, _
         GradientColorStart, GradientColorEnd, _
         lRight - lSideBarWidth, lTop, lSideBarWidth, lBottom - lTop, _
         True
   Else
      UtilDrawBackground lHDC, _
         GradientColorStart, GradientColorEnd, _
         lLeft, lTop, lSideBarWidth, lBottom - lTop, _
         True
   End If
'////////////////////Add again
If od Then
 BitBlt m_cCache.hDC, 0, 0, lRight, lBottom, lHDC, 0, 0, vbSrcCopy
End If
'////////////////////end
End Sub

Friend Sub fPaintOneButton(ByVal lIndex As Long)
   '
   If (m_bRedraw And m_bVisible) Then
         
      ' the bar:
      If Len(m_sToolBarKey) > 0 Then
         
         Dim barInt As cCommandBarInt
         Set barInt = mCommandBars.BarItem(m_sToolBarKey)
         '///////////Add!!
         Set barInt.The__owner = Me
         '///////////End
         If Not (barInt Is Nothing) Then
      
            Dim lHDC As Long
            lHDC = UserControl.hDC
            Dim tR As RECT
            GetClientRect m_hWnd, tR
                     
            ' Set up to draw the button:
            Dim cDP As New cDrawButtonParams
               
            cDP.hWnd = m_hWnd
            cDP.hDC = lHDC
            cDP.FontFace = UserControl.Font.Name
            cDP.FontSize = UserControl.Font.Size
            cDP.hFont = plGetHFont()
            cDP.Enabled = m_bEnabled
            cDP.RightToLeft = pbRightToLeft()
            If (m_bPopup) Then
               Set cDP.ImageList = m_cMenuImageList
               cDP.Orientation = eTop
               If (m_bPopupVisibleChecks) Then
                  cDP.SizeStyle = COMMANDBARSIZESTYLEMENUVISIBLECHECK
               Else
                  cDP.SizeStyle = COMMANDBARSIZESTYLEMENU
               End If
            Else
               Set cDP.ImageList = m_cToolbarImageList
               cDP.Orientation = m_eOrientation
               If (m_bWrappable) Then
                  cDP.SizeStyle = COMMANDBARSIZESTYLETOOLBARWRAPPABLE
               Else
                  cDP.SizeStyle = COMMANDBARSIZESTYLETOOLBAR
               End If
            End If
            cDP.Left = m_item(lIndex).Left
            cDP.Top = m_item(lIndex).Top
            cDP.Size = m_item(lIndex).Right - m_item(lIndex).Left
            cDP.Height = m_item(lIndex).Bottom - m_item(lIndex).Top
            cDP.MouseDownButton = m_item(lIndex).mouseDown
            cDP.MouseOverButton = m_item(lIndex).mouseOver
            cDP.MouseDownSplit = m_item(lIndex).MouseDownSplit
            cDP.MouseOverSplit = m_item(lIndex).MouseOverSplit
            cDP.ShowingMenu = m_item(lIndex).ShowingMenu
            cDP.Hidden = m_item(lIndex).Hidden
            cDP.ButtonPosition = m_eButtonPosition
            If (m_eOrientation = eLeft) Or (m_eOrientation = eRight) Then
               cDP.ToolbarSize = tR.Right - tR.Left
            Else
               cDP.ToolbarSize = tR.Bottom - tR.Top
            End If
   '////////////////////////////Add--Modified
   Dim lBackWidth As Long
   Dim lBackHeight As Long
   Dim lBackLeft As Long
   Dim lBackTop As Long
   If od Then
               lBackWidth = m_item(lIndex).Right - m_item(lIndex).Left
               lBackHeight = m_item(lIndex).Bottom - m_item(lIndex).Top
               lBackLeft = m_item(lIndex).Left
               lBackTop = m_item(lIndex).Top
               BitBlt lHDC, lBackLeft, lBackTop, lBackWidth, lBackHeight, m_cCache.hDC, lBackLeft, lBackTop, vbSrcCopy
   Else
            ' paint the background to the item:
            If (cDP.SizeStyle = COMMANDBARSIZESTYLETOOLBARWRAPPABLE) Or _
               (cDP.SizeStyle = COMMANDBARSIZESTYLETOOLBAR) Then
               lBackWidth = m_item(lIndex).Right - m_item(lIndex).Left
               lBackHeight = m_item(lIndex).Bottom - m_item(lIndex).Top
               lBackLeft = m_item(lIndex).Left
               lBackTop = m_item(lIndex).Top
               GetClientRect m_hWnd, tR
               If (m_eOrientation = eLeft) Or (m_eOrientation = eRight) Then
                  lBackLeft = 0
                  lBackWidth = tR.Right - tR.Left
               Else
                  lBackHeight = tR.Bottom - tR.Top
               End If
               If Not (m_cBack Is Nothing) Then
                  TileArea lHDC, lBackLeft, lBackTop, lBackWidth, lBackHeight, _
                     m_cBack.hDC, m_cBack.Width, m_cBack.Height, 0
               Else
                  If (m_bMainMenu) Or (GradientColorStart = -1) Then
                     UtilDrawBackgroundPortion m_hWnd, m_hWndParent, lHDC, _
                        GradientColorStart, GradientColorEnd, _
                        lBackLeft, lBackTop, _
                        lBackWidth, lBackHeight, _
                        True, (Style = eComCtl32)
                  Else
                     UtilDrawBackground lHDC, GradientColorStart, GradientColorEnd, _
                        lBackLeft, lBackTop, _
                        lBackWidth, lBackHeight, _
                        ((m_eOrientation = eLeft) Or (m_eOrientation = eRight))
                  End If
               End If
            Else
               Dim lTop As Long
               lTop = m_item(lIndex).Top
               If (lIndex = 1) Then lTop = lTop + 1 ' comment-on-dit 'hax0r'?
               If m_item(lIndex).Left <= 2 Then
                  pPaintMenuBackground lHDC, _
                     m_item(lIndex).Left, lTop, _
                     m_item(lIndex).Right, m_item(lIndex).Bottom, _
                     True
               Else
                  UtilDrawBackground lHDC, MenuBackgroundColorStart, MenuBackgroundColorEnd, _
                     m_item(lIndex).Left, lTop, _
                     m_item(lIndex).Right - m_item(lIndex).Left, m_item(lIndex).Bottom - m_item(lIndex).Top, _
                     True
               End If
            End If
   End If
   '////////////////////////////////End
   
            barInt.DrawOneButton cDP, lIndex
      
         End If
         
      End If
   
      UserControl.Refresh
   
   End If
   '

End Sub

Friend Function fHitTest(ByVal x As Long, ByVal y As Long) As Long
Dim i As Long
   If Len(m_sToolBarKey) > 0 Then
      Dim barInt As cCommandBarInt
      Set barInt = mCommandBars.BarItem(m_sToolBarKey)
      If Not (barInt Is Nothing) Then
         For i = 1 To barInt.count
            If (x >= m_item(i).Left) And (x <= m_item(i).Right) Then
               If (y >= m_item(i).Top And y <= m_item(i).Bottom) Then
                  fHitTest = i
                  Exit For
               End If
            End If
         Next i
      End If
   End If
End Function

Friend Function fTrack( _
      ByVal button As MouseButtonConstants, _
      ByVal iIndex As Long, _
      Optional ByVal mouseDown As Boolean = False, _
      Optional ByVal fromKey As Boolean = False _
   ) As Long
   
   Dim sToolTip As String
   
   If Len(m_sToolBarKey) > 0 Then
   
      Dim barInt As cCommandBarInt
      Set barInt = mCommandBars.BarItem(m_sToolBarKey)
      
      If Not (barInt Is Nothing) Then
         
         Dim i As Long
         Dim j As Long
         Dim changeCount As Long
         Dim changeIndex() As Long
         Dim track As Boolean
         Dim found As Long
         Dim tP As POINTAPI
         Dim xOffset As Long
         Dim yOffset As Long
         Dim addChange As Boolean
         Dim indexMouseOver As Long

         For i = 1 To barInt.count
            addChange = False
            
            If (i = iIndex) Then
               
               sToolTip = barInt.Item(i).TooltipText(True)
               
               'If (barInt.Item(i).CanAction(m_eOrientation,m_bPopup, m_bPopupVisibleChecks)) Then
                                    
                  If (barInt.Item(i).Style = eSplit) Then
                     ' check if we're over split or not:
                     GetCursorPos tP
                     LSet m_tLastMousePos = tP
                     ScreenToClient m_hWnd, tP
                     xOffset = tP.x - m_item(i).Left
                     yOffset = tP.y - m_item(i).Top
                     Dim OverSplit As Boolean
                     OverSplit = barInt.Item(i).OverSplit( _
                        xOffset, yOffset, _
                        m_item(i).Right - m_item(i).Left, m_item(i).Bottom - m_item(i).Top, _
                        pbRightToLeft(), m_eOrientation)
                     If (OverSplit) Then
                        If Not (m_item(i).MouseOverSplit) Then
                           If (button = vbLeftButton) Then
                              m_item(i).MouseOverSplit = m_item(i).MouseDownSplit
                           Else
                              m_item(i).MouseOverSplit = True
                           End If
                           m_item(i).mouseOver = False
                           addChange = True
                        End If
                     Else
                        If Not (m_item(i).mouseOver) Then
                           If (button = vbLeftButton) Then
                              m_item(i).mouseOver = m_item(i).mouseDown
                           Else
                              m_item(i).mouseOver = True
                           End If
                           m_item(i).MouseOverSplit = False
                           addChange = True
                        End If
                     End If
                  Else
                     If Not (m_item(i).mouseOver) Then
                        If (button = vbLeftButton) Then
                           m_item(i).mouseOver = m_item(i).mouseDown
                        Else
                           m_item(i).mouseOver = True
                        End If
                        addChange = True
                     End If
                  End If
                  
                  If (addChange) Then
                     track = True
                  End If
                                 
                  If mouseDown Then
                     track = False
                     If (barInt.Item(i).Style = eSplit) Then
                        If (OverSplit) Then
                           If Not (m_item(i).MouseDownSplit) Then
                              m_item(i).MouseDownSplit = True
                              m_item(i).mouseDown = False
                              m_item(i).MouseOverSplit = True
                              m_item(i).mouseOver = False
                              addChange = True
                           End If
                        Else
                           If Not (m_item(i).mouseDown) Then
                              m_item(i).mouseDown = True
                              m_item(i).MouseDownSplit = False
                              m_item(i).mouseOver = True
                              m_item(i).MouseOverSplit = False
                              addChange = True
                           End If
                        End If
                     Else
                        If Not (m_item(i).mouseDown) Then
                           m_item(i).mouseDown = True
                           addChange = True
                        End If
                     End If
                  End If
               
                  If (addChange) Then
                     changeCount = changeCount + 1
                     ReDim Preserve changeIndex(1 To changeCount) As Long
                     changeIndex(changeCount) = iIndex
                  End If
                  
               'End If
            
            Else
            
               If (m_item(i).mouseOver) Or (m_item(i).MouseOverSplit) Then
                  m_item(i).mouseOver = False
                  m_item(i).MouseOverSplit = False
                  changeCount = changeCount + 1
                  ReDim Preserve changeIndex(1 To changeCount) As Long
                  changeIndex(changeCount) = i
               End If
               
            End If
            
         Next i
         
         If (changeCount > 0) Then
            For i = 1 To changeCount
               If Not (m_bWrappable Or m_bMainMenu) Then
                  fPaintOneButton changeIndex(i)
               End If
               If (m_item(changeIndex(i)).mouseOver) Or (m_item(changeIndex(i)).MouseOverSplit) Then
                  indexMouseOver = changeIndex(i)
               End If
            Next i
            If (m_bWrappable Or m_bMainMenu) Then
               fPaint
            End If
            If InMenuLoop Then
               If (indexMouseOver > 0) Then
                  If Not fromKey Then
                     processMenuMouseOver indexMouseOver
                     If (m_bPopup) Then
                        ActiveMenu = m_hWnd
                     End If
                  End If
               End If
            End If
         End If
         
         If (track And Not (fromKey)) Then
            tmrLostMouse.Enabled = True
         End If
      End If
            
   End If
   
   If Not (StrComp(sToolTip, m_sLastToolTip) = 0) Then
      On Error Resume Next
      UserControl.Extender.TooltipText = sToolTip
      m_sLastToolTip = sToolTip
   End If
   
End Function

Friend Sub fKeyDown(ByVal vKey As Long, ByVal Shift As Long)
On Error GoTo ErrorHandler

Dim ctl As vbalCommandBar
Dim barInt As cCommandBarInt
Dim i As Long
Dim iSelected As Long

   '
   If Len(m_sToolBarKey) > 0 Then

      Set barInt = mCommandBars.BarItem(m_sToolBarKey)
      If Not (barInt Is Nothing) Then

         For i = 1 To barInt.count
            If (m_item(i).mouseOver) Or (m_item(i).ShowingMenu) Then
               iSelected = i
               Exit For
            End If
         Next i

         If (InMenuLoop) Then
            If (m_bPopup) Then
               
               ActiveMenu = m_hWnd
               
               Select Case vKey
               Case vbKeyLeft
                  ' next menu to the left
                  pSelectNextMenu -1
                  
               Case vbKeyRight
                  ' next menu to the right
                  pSelectNextMenu 1
                  
               Case vbKeyUp
                  ' select next item upwards, wrapping at the end
                  pSelectMenuItem -1
                  
               Case vbKeyDown
                  ' select next item downwards, wrapping at the end
                  pSelectMenuItem 1
                  
               Case vbKeyHome
                  ' select the first item
                  pSelectMenuItem 0, True, False
               
               Case vbKeyEnd
                  ' select the last item
                  pSelectMenuItem 0, False, True
               
               Case vbKeyEscape
                  ' Cancel menu
                  If (ControlFromhWnd(m_hWndShownFrom, ctl)) Then
                     ctl.fCloseMenus False
                     If (m_bPopup) Then
                        m_eMenuTrackMode = 0
                     End If
                  End If
                  
               Case vbKeyReturn
                  ' Select item
                  If (iSelected > 0) Then
                     If (barInt.Item(iSelected).Bar Is Nothing) Then
                        fClickButton iSelected
                     Else
                        pShowDropDown iSelected, True
                     End If
                  End If
               
               Case Else
                  ' See if the key matches any of the
                  ' accelerators in this control, if so
                  ' select it
                  For i = 1 To barInt.count
                     If (barInt.Item(i).AltKeyMatches(vKey)) Then
                        If (barInt.Item(i).Bar Is Nothing) Then
                           fClickButton i
                        Else
                           pShowDropDown i, True
                        End If
                        Exit For
                     End If
                  Next i
               
               
               End Select
               
            Else
               If (m_eOrientation = eLeft) Or (m_eOrientation = eRight) Then
                  Select Case vKey
                  Case vbKeyLeft
                     vKey = vbKeyUp
                  Case vbKeyRight
                     vKey = vbKeyDown
                  Case vbKeyUp
                     vKey = vbKeyLeft
                  Case vbKeyDown
                     vKey = vbKeyRight
                  End Select
               End If
            
               Select Case vKey
               Case vbKeyLeft
                  pSelectMenuItem -1
                  
               Case vbKeyRight
                  pSelectMenuItem 1
                  
               Case vbKeyDown, vbKeyUp
                  pShowDropDown iSelected, True
               
               Case vbKeyEscape
                  SetInMenuLoop False, 0
                  pMouseMove 0, 0
               
               Case Else
                  ' See if the key matches any of the
                  ' accelerators in this control, if so
                  ' call pShowDropDown
                  For i = 1 To barInt.count
                     If (barInt.Item(i).AltKeyMatches(vKey)) Then
                        pShowDropDown i, True
                        Exit For
                     End If
                  Next i
                  
               End Select
            
            End If
         End If
         
      End If
   End If
   '
   Exit Sub
   
ErrorHandler:
   Debug.Print "Error in fKeyDown!!"
   Exit Sub
   
End Sub

Private Sub pSelectNextMenu( _
      ByVal iDir As Long _
   )
Dim iCurrentSelection As Long
Dim bCurrentSelectionHasPopup As Boolean
Dim bCurrentSelectionShowingPopup As Boolean
Dim iIndex As Long
Dim iNextSelection As Long
Dim ctl As vbalCommandBar
   
   If Len(m_sToolBarKey) > 0 Then
      Dim barInt As cCommandBarInt
      Set barInt = mCommandBars.BarItem(m_sToolBarKey)
      If Not (barInt Is Nothing) Then
         If (barInt.count > 0) Then

            For iIndex = 1 To barInt.count
               If (m_item(iIndex).mouseOver Or m_item(iIndex).ShowingMenu) Then
                  iCurrentSelection = iIndex
                  If Not (barInt.Item(iCurrentSelection).Bar Is Nothing) Then
                     bCurrentSelectionHasPopup = True
                     bCurrentSelectionShowingPopup = m_item(iCurrentSelection).ShowingMenu
                  End If
                  Exit For
               End If
            Next iIndex

            
            If (iDir = 1) Then
               ' check if there is a submenu for the currently selected item:
               If (bCurrentSelectionHasPopup) Then
                  ' Show that item
                  pShowDropDown iCurrentSelection, True
                  ' & exit
                  Exit Sub
               End If
            End If
            
            iNextSelection = iCurrentSelection + iDir
            If (iNextSelection < 1) Then
               iNextSelection = barInt.count
            ElseIf (iNextSelection > barInt.count) Then
               iNextSelection = 1
            End If
                        
            fKeyDown vbKeyEscape, 0
                        
            If (ControlFromhWnd(ActiveMenu, ctl)) Then
               If Not (ctl.fIsSetAsMenu) Then
                  ctl.fSelectNextMenu iDir
               ElseIf (iDir = 1) Then
                  If (ControlFromhWnd(menuInitiator, ctl)) Then
                     ctl.fSelectNextMenu iDir
                  End If
               End If
         '      If ctl.fIsSetAsMenu Then
         '         ctl.fKeyDown IIf(iDir = -1, vbKeyLeft, vbKeyRight), 0
            End If
            
         End If
      End If
   End If
End Sub

Friend Sub fSelectNextMenu(ByVal iDir As Long)
Dim barInt As cCommandBarInt
Dim i As Long
Dim iSelected As Long
Dim iStartIndex As Long
Dim bActiveSelection As Boolean
Dim ctl As vbalCommandBar

   If Len(m_sToolBarKey) > 0 Then
      Set barInt = mCommandBars.BarItem(m_sToolBarKey)
      If Not (barInt Is Nothing) Then
         For i = 1 To barInt.count
            If (m_item(i).mouseOver Or m_item(i).ShowingMenu) Then
               iSelected = i
               Exit For
            End If
         Next i
         
         If (iSelected = 0) Then
            iSelected = 1
         End If
         iStartIndex = iSelected

         Do
            iSelected = iSelected + iDir
            If (iSelected <= 0) Then
               iSelected = barInt.count
            ElseIf (iSelected > barInt.count) Then
               iSelected = 1
            End If
            If (iSelected = iStartIndex) Then
               Exit Do
            End If
            bActiveSelection = Not (m_item(iSelected).Hidden)
            If (bActiveSelection) Then
               With barInt.Item(iSelected)
                  bActiveSelection = .Enabled And .Visible And Not (.Style = eSeparator) Or (.Style = ePanel)
               End With
            End If
         Loop While Not bActiveSelection
         
         fTrack 0, iSelected
         If (ControlFromhWnd(ActiveMenu, ctl)) Then
            ctl.fKeyDown vbKeyDown, 0
         End If
      End If
   End If
End Sub

Private Sub pSelectMenuItem( _
      ByVal iDir As Long, _
      Optional ByVal bFirst As Boolean = False, _
      Optional ByVal bLast As Boolean = False _
   )
Dim iCurrentSelection As Long
Dim iNewSelection As Long
Dim iIndex As Long
Dim iStartSelection As Long

   If Len(m_sToolBarKey) > 0 Then
      Dim barInt As cCommandBarInt
      Set barInt = mCommandBars.BarItem(m_sToolBarKey)
      If Not (barInt Is Nothing) Then
         If (barInt.count > 0) Then

            For iIndex = 1 To barInt.count
               If (m_item(iIndex).mouseOver Or m_item(iIndex).ShowingMenu) Then
                  iCurrentSelection = iIndex
                  Exit For
               End If
            Next iIndex

            If (bFirst) Then
               iNewSelection = 1
               iDir = 1
            ElseIf (bLast) Then
               iNewSelection = barInt.count
               iDir = -1
            Else
               iNewSelection = iCurrentSelection + iDir
               If (iNewSelection < 1) Then
                  iNewSelection = barInt.count
               ElseIf (iNewSelection > barInt.count) Then
                  iNewSelection = 1
               End If
            End If
            
            iStartSelection = iNewSelection
            Do While (barInt.Item(iNewSelection).Style = eSeparator) Or Not (barInt.Item(iNewSelection).Visible)
               iNewSelection = iNewSelection + iDir
               If (iNewSelection = iStartSelection) Then
                  Exit Sub
               End If
               If (iNewSelection < 1) Then
                  iNewSelection = barInt.count
               ElseIf (iNewSelection > barInt.count) Then
                  iNewSelection = 1
               End If
            Loop
            
            If Not (iNewSelection = iCurrentSelection) Then
               ' select the new item:
               fTrack 0, iNewSelection, , True
               tmrLostMouse.Enabled = False
            End If
            
         End If
      End If
   End If
   
End Sub

Private Sub processMenuMouseOver(ByVal indexMouseOver As Long)
   
   If Not (m_item(indexMouseOver).ShowingMenu) Then
      Dim barInt As cCommandBarInt
      Set barInt = mCommandBars.BarItem(m_sToolBarKey)
      If (barInt.Item(indexMouseOver).CanAction(m_eOrientation, m_bPopup, m_bPopupVisibleChecks)) Then
         If Not (m_bPopup) Then
            fCloseMenus True
            pShowDropDown indexMouseOver
         Else
            tmrMenuPopup.Tag = indexMouseOver
            tmrMenuPopup.Enabled = True
         End If
      End If
   End If
   
End Sub
Friend Sub fSetShownFrom( _
      ctl As vbalCommandBar, _
      ByVal hWndShownFromParent As Long, _
      ByVal ePopoutDirection As ECommandBarOrientation, _
      ByVal lPopoutStart As Long, _
      ByVal lPopoutExtent As Long, _
      ByVal hMonitorOn As Long _
   )
   m_hWndShownFrom = ctl.hWnd
   m_hWndShownFromParent = hWndShownFromParent
   m_eMenuPopoutDirection = ePopoutDirection
   m_lMenuPopoutStart = lPopoutStart
   m_lMenuPopoutExtent = lPopoutExtent
   m_hMonitorOn = hMonitorOn
   m_bMainMenu = False
   GetCursorPos m_tLastMousePos
   fInUse = True
End Sub

Friend Property Get fInUse() As Boolean
   fInUse = m_bInUse
End Property
Friend Property Let fInUse(ByVal bState As Boolean)
   m_bInUse = bState
   If (m_bInUse) Then
      Enabled = True
   End If
End Property
Friend Sub fRaiseHiddenMenuClickEvent(cBtn As cButtonInt)
   
   '
   Dim btn As New cButton
   btn.fInit m_hWnd, cBtn.Key
   RaiseEvent ButtonClick(btn)
   '
   
End Sub
Friend Sub fClickButton(ByVal index As Long)
   
   If Len(m_sToolBarKey) > 0 Then
      Dim barInt As cCommandBarInt
      Set barInt = mCommandBars.BarItem(m_sToolBarKey)
      If Not (barInt Is Nothing) Then
         
         If (InMenuLoop) Then
            If (barInt.Item(index).Bar Is Nothing) Then
               If m_bPopupVisibleChecks Then
                  If Not (barInt.Item(index).VisibleCheck = vbGrayed) Then
                     fPaintOneButton index
                     barInt.Item(index).Visible = (barInt.Item(index).VisibleCheck = vbChecked)
                  Else
                     SetInMenuLoop False, 0
                  End If
               Else
                  SetInMenuLoop False, 0
               End If
            End If
         End If
                  
         barInt.ClickButton index
         If Not (m_item(index).ShowingMenu) Then
            Dim c As New cButton
            c.fInit m_hWnd, barInt.Item(index).Key
            RaiseEvent ButtonClick(c)
            '////////////////////////Add!!
            Dim lhWnd As Long, r As RECT, i As Long, j As Long
            Dim lHDC As Long
            Dim frm As New frmTemp
            If m_bPopup And Is2000OrAbove Then
             DoEvents
             GetWindowRect m_hWnd, r
             With m_item(index)
'lhWnd = CreateWindowEX(WS_EX_TOPMOST Or WS_EX_TOOLWINDOW Or WS_EX_LAYERED, _
'"Static", "", WS_POPUP Or SS_OWNERDRAW, _
'r.left + .left, r.top + .top, .right - .left, .bottom - .top, _
'0, 0, App.hInstance, ByVal 0&)
Load frm
lhWnd = frm.hWnd
SetWindowLong lhWnd, GWL_EXSTYLE, WS_EX_TOPMOST Or WS_EX_TOOLWINDOW Or WS_EX_LAYERED
SetWindowPos lhWnd, HWND_TOPMOST, r.Left + .Left, r.Top + .Top, .Right - .Left, .Bottom - .Top, SWP_SHOWWINDOW Or SWP_NOACTIVATE
              'SetLayeredWindowAttributes lhWnd, 0, 255, LWA_ALPHA
              lHDC = GetDC(lhWnd)
              j = trans
              If j <= 0 Or j > 255 Then j = 255
              For i = j To 0 Step -24
               SetLayeredWindowAttributes lhWnd, 0, i, LWA_ALPHA
               If i = j Then BitBlt lHDC, 0, 0, .Right - .Left, .Bottom - .Top, UserControl.hDC, .Left, .Top, vbSrcCopy
               Sleep 10
              Next i
             End With
             ReleaseDC lhWnd, lHDC
             DestroyWindow lhWnd
             Unload frm
            End If
            '////////////////////////
         End If
         
      End If
   End If
   
End Sub
Friend Sub fDropDownButton(ByVal index As Long)
   
   If Len(m_sToolBarKey) > 0 Then
      
      Dim barInt As cCommandBarInt
      Set barInt = mCommandBars.BarItem(m_sToolBarKey)
      If Not (barInt Is Nothing) Then
         If Not (barInt.Item(index).Bar Is Nothing) Then
            Dim c As New cButton
            c.fInit m_hWnd, barInt.Item(index).Key
            
            Dim bCancel As Boolean
            RaiseEvent ButtonDropDown(c, bCancel)
            If Not (bCancel) Then
            '
               ' Time to show a drop-down:
               pShowDropDown index
               '
            End If
         End If
      End If
   End If
End Sub

Private Sub pShowDropDown(ByVal index As Long, Optional ByVal selectFirst As Boolean = False)
   
   If Len(m_sToolBarKey) > 0 Then
      
      Dim barInt As cCommandBarInt
      Set barInt = mCommandBars.BarItem(m_sToolBarKey)
      If Not (barInt Is Nothing) Then
         
         Dim barDropDownInt As cCommandBarInt
         Set barDropDownInt = barInt.Item(index).Bar
   
         If Not (barDropDownInt Is Nothing) Then
            pShowDropDownBar barDropDownInt, index, , , selectFirst
         End If
         
      End If
   End If
   
End Sub
Private Function pShowDropDownBar( _
      barDropDownInt As cCommandBarInt, _
      Optional ByVal index As Long = 0, _
      Optional ByVal showAtX As Long = 0, _
      Optional ByVal showAtY As Long = 0, _
      Optional ByVal selectFirst As Boolean = False, _
      Optional ByVal fromShowPopupMethod As Boolean = False _
   ) As vbalCommandBar
   
   ' Get a new instance:
   Dim ctl As vbalCommandBar
   Set ctl = mCommandBars.NewInstance()
   
   ' Assuming we received one:
   If Not (ctl Is Nothing) Then
      
      Dim Bar As New cCommandBar
      Bar.fInit ctl.hWnd, barDropDownInt.Key
      RaiseEvent BeforeShowMenu(Bar)
      
      ' turn it into a menu:
      ctl.fSetAsMenu
      ' set the image list:
      ctl.fSetImageListAndFont m_cToolbarImageList, m_cMenuImageList, Font
      
      ' set the key:
      Dim barDropDown As cCommandBar
      Set barDropDown = New cCommandBar
      barDropDown.fInit m_hWnd, barDropDownInt.Key
      Set ctl.Toolbar = barDropDown
      
      ' Now show it at the appropriate position:
      pShowMenu ctl, index, showAtX, showAtY, selectFirst, fromShowPopupMethod
      
      ' Debug.Print "Would add " & Hex(ctl.hWnd) & " to trail here"
      AddPopupToTrail ctl.hWnd, m_hWnd, fromShowPopupMethod, (fromShowPopupMethod And m_bPopup)
      
      Set pShowDropDownBar = ctl
      
   End If
            

End Function

Private Sub pShowMenu( _
      ByRef ctlPopup As vbalCommandBar, _
      ByVal index As Long, _
      ByVal showAtX As Long, _
      ByVal showAtY As Long, _
      ByVal selectFirst As Boolean, _
      ByVal fromShowPopupMethod As Boolean _
   )
   '////////////Add!!
   With ctlPopup
    .Transparency = trans
    .OwnerDraw = od
   End With
   '/////////////
Dim tR As RECT
Dim tROrig As RECT
Dim tP As POINTAPI
Dim tPCalc As POINTAPI
Dim cM As New cMonitor
Dim lMinX As Long
Dim lMaxX As Long
Dim lMinY As Long
Dim lMaxY As Long
Dim lhWnd As Long
Dim ePopoutDirection As ECommandBarOrientation
Dim lPopoutStart As Long
Dim lPopoutExtent As Long
Dim hWndShownFromParent As Long
Dim i As Long, j As Long
      
   ' Get the size of the menu item:
   lhWnd = ctlPopup.hWnd
   GetWindowRect lhWnd, tR
   OffsetRect tR, -tR.Left, -tR.Top
   LSet tROrig = tR
   
   If (index > 0) Then
      ' Calculate menu position for drop-down from an item
      If (m_bPopup) Then
         If (m_hWndShownFrom = 0) Or (m_eMenuPopoutDirection = eTop) Or (m_eMenuPopoutDirection = eBottom) Then
            If (pbRightToLeft()) Then
               ePopoutDirection = eRight
            Else
               ePopoutDirection = eLeft
            End If
         Else
            ePopoutDirection = m_eMenuPopoutDirection
         End If
         If (ePopoutDirection = eLeft) Then
            tP.x = m_item(index).Right
         Else
            tP.x = m_item(index).Left
         End If
         tP.y = m_item(index).Top
         ClientToScreen m_hWnd, tP
         If (ePopoutDirection = eLeft) Then
            OffsetRect tR, tP.x - 1, tP.y - 1
         Else
            OffsetRect tR, tP.x - (tR.Right - tR.Left) + 1, tP.y - 1
         End If
      Else
         
         Select Case m_eOrientation
         Case eLeft, eRight
            ePopoutDirection = m_eOrientation
            If (m_eOrientation = eLeft) Then
               tP.x = m_item(index).Right - IIf(Style = eComCtl32, 0, 2)
            Else
               tP.x = m_item(index).Left + IIf(Style = eComCtl32, 0, 2)
            End If
            tP.y = m_item(index).Top + IIf(Style = eComCtl32, 0, 1)
            ClientToScreen m_hWnd, tP
            If (m_eOrientation = eLeft) Then
               OffsetRect tR, tP.x, tP.y
            Else
               OffsetRect tR, tP.x - (tR.Right - tR.Left), tP.y
            End If
            lPopoutStart = tP.y
            tPCalc.y = m_item(index).Bottom - 1
            ClientToScreen m_hWnd, tPCalc
            lPopoutExtent = tPCalc.y - lPopoutStart
            
         Case eTop, eBottom
            ePopoutDirection = eTop
            If (pbRightToLeft()) Then
               tP.x = m_item(index).Right + IIf(Style = eComCtl32, 0, -1)
            Else
               tP.x = m_item(index).Left + IIf(Style = eComCtl32, 0, 1)
            End If
            'If (m_eOrientation = eTop) Then
               tP.y = m_item(index).Bottom - IIf(Style = eComCtl32, 0, 2)
            'Else
            '   tP.y = m_item(index).Top + 2
            'End If
            ClientToScreen m_hWnd, tP
            If (pbRightToLeft()) Then
               OffsetRect tR, tP.x - (tR.Right - tR.Left), 0
            Else
               OffsetRect tR, tP.x, 0
            End If
            'If (m_eOrientation = eTop) Then
               OffsetRect tR, 0, tP.y
            'Else
            '   OffsetRect tR, 0, tP.y - (tR.bottom - tR.Top)
            'End If
            If (pbRightToLeft()) Then
               lPopoutExtent = tP.x
               tPCalc.x = m_item(index).Left + 1
               ClientToScreen m_hWnd, tPCalc
               lPopoutExtent = lPopoutExtent - tPCalc.x
               lPopoutStart = tPCalc.x
            Else
               lPopoutStart = tP.x
               tPCalc.x = m_item(index).Right - 1
               ClientToScreen m_hWnd, tPCalc
               lPopoutExtent = tPCalc.x - lPopoutStart
            End If
            
            
         End Select
      End If
            
      If (m_hMonitorOn = 0) Then
         cM.CreateFromPoint tP.x, tP.y
      Else
         cM.fInit m_hMonitorOn
      End If
      If (cM.hMonitor = 0) Then
         lMinX = 0
         lMaxX = Screen.Width \ Screen.TwipsPerPixelX
         lMinY = 0
         lMaxY = Screen.Height \ Screen.TwipsPerPixelY
      Else
         lMinX = cM.WorkLeft
         lMaxX = cM.WorkLeft + cM.WorkWidth
         lMinY = cM.WorkTop
         lMaxY = cM.WorkTop + cM.WorkHeight
      End If
      
      If (tR.Top >= lMinY) And (tR.Bottom <= lMaxY) Then
         ' It fits, we can display it
      Else
         ' Good in x, bad in y
         
         If (tR.Bottom > lMaxY) Then
            ' The bottom is off the bottom of the screen
            If (m_bPopup) Then
               ' shift vertically until we can see the menu
               OffsetRect tR, 0, -(tR.Bottom - lMaxY)
            Else
               Select Case ePopoutDirection
               Case eTop
                  ' show as if it was from a bottom aligned menu
                  ScreenToClient m_hWnd, tP
                  tP.y = m_item(index).Top + 2
                  ClientToScreen m_hWnd, tP
                  LSet tR = tROrig
                  If (pbRightToLeft()) Then
                     OffsetRect tR, tP.x - (tR.Right - tR.Left), 0
                  Else
                     OffsetRect tR, tP.x, 0
                  End If
                  OffsetRect tR, 0, tP.y - (tR.Bottom - tR.Top)
                  ePopoutDirection = eBottom
               
               Case eBottom
                  ' This should not occur, as we're popping up from the bottom.
                  ' If it did, the implication is that the button is offscreen
                  ' and if we moved it, then menu would be disconnected from the
                  ' toolbar button that was used to show it.
                  
               Case eLeft, eRight
                  ' shift vertically until we can see the menu
                  OffsetRect tR, 0, -(tR.Bottom - lMaxY)
                  
               End Select
            End If
            
         Else
            ' The top is off the top of the screen
            If (m_bPopup) Then
               ' This will get sorted by the check later
               
            Else
               Select Case ePopoutDirection
               Case eTop
                  ' This should not occur, as we're popping up from the bottom.
                  ' If it did, the implication is that the button is offscreen
                  ' and if we moved it, then menu would be disconnected from the
                  ' toolbar button that was used to show it.
               
               
               Case eBottom
                  ' show as if it was from a bottom aligned menu
                  ScreenToClient m_hWnd, tP
                  tP.y = m_item(index).Bottom - 2
                  ClientToScreen m_hWnd, tP
                  LSet tR = tROrig
                  If (pbRightToLeft()) Then
                     OffsetRect tR, tP.x - (tR.Right - tR.Left), 0
                  Else
                     OffsetRect tR, tP.x, 0
                  End If
                  OffsetRect tR, 0, tP.y
                  ePopoutDirection = eTop
                  
               Case eLeft, eRight
                  ' This will get sorted by the check later
                  
               End Select
            End If
            
            
         End If
            
         ' We always keep the top is on screen:
         If (tR.Top < lMinY) Then
            OffsetRect tR, 0, lMinY - tR.Top
         End If
         
      End If
         
      If (tR.Left >= lMinX) And (tR.Right <= lMaxX) Then
         ' It fits, we can display it
      Else
         ' Good in y, bad in x
         If (tR.Right > lMaxX) Then
            ' Off the screen to the right
            If (m_bPopup) Then
               ' show on the opposite side of the menu from the one
               ' currently selected:
               If (ePopoutDirection = eLeft) Then
                  tP.x = m_item(index).Left
                  ePopoutDirection = eRight
               Else
                  tP.x = m_item(index).Right
                  ePopoutDirection = eLeft
               End If
               tP.y = m_item(index).Top
               ClientToScreen m_hWnd, tP
               tR.Left = tROrig.Left
               tR.Right = tROrig.Right
               If (ePopoutDirection = eRight) Then
                  OffsetRect tR, tP.x - (tR.Right - tR.Left) + 1, 0
               Else
                  OffsetRect tR, tP.x - 1, 0
               End If
                        
            Else
               Select Case ePopoutDirection
               Case eTop, eBottom
                  ' shift left until it is displayed
                  OffsetRect tR, -(tR.Right - lMaxX), 0
               
               Case eLeft
                  ' Show as if from a right menu
                  ScreenToClient m_hWnd, tP
                  tP.x = m_item(index).Left + 2
                  ClientToScreen m_hWnd, tP
                  tR.Left = tROrig.Left
                  tR.Right = tROrig.Right
                  OffsetRect tR, tP.x - (tR.Right - tR.Left), 0
                  ePopoutDirection = eRight
                  
               Case eRight
                  '
                  
               End Select
            
            End If
         Else
            ' Off the screen to the left
            If (m_bPopup) Then
               ' show on the opposite side of the menu from the one
               ' currently selected:
               If (ePopoutDirection = eLeft) Then
                  tP.x = m_item(index).Left
                  ePopoutDirection = eRight
               Else
                  tP.x = m_item(index).Right
                  ePopoutDirection = eLeft
               End If
               tP.y = m_item(index).Top
               ClientToScreen m_hWnd, tP
               tR.Left = tROrig.Left
               tR.Right = tROrig.Right
               If (ePopoutDirection = eRight) Then
                  OffsetRect tR, tP.x - (tR.Right - tR.Left) + 1, 0
               Else
                  OffsetRect tR, tP.x - 1, 0
               End If
            
            Else
               Select Case ePopoutDirection
               Case eTop, eBottom
                  ' Shift right until displayed
                  
               Case eLeft
                  '
                  
               Case eRight
                  ' Show as if from a left menu
                  ScreenToClient m_hWnd, tP
                  tP.x = m_item(index).Right - 2
                  ClientToScreen m_hWnd, tP
                  tR.Left = tROrig.Left
                  tR.Right = tROrig.Right
                  OffsetRect tR, tP.x, 0
                  ePopoutDirection = eLeft
                  
               End Select
               
            End If
         End If
      End If
   
   Else
      ' We're showing a popup menu
      OffsetRect tR, showAtX, showAtY
         
   End If
   
   ' Hide any menus that we're showing at the moment:
   fCloseMenus False
   
   ' Tell the item we're showing whom it is showing from, and
   ' where the button rectangle that was used to show it is
   ' located on the screen:
   SetInMenuLoop True, IIf(fromShowPopupMethod, 0, m_hWnd)
   If (m_bPopup) Then
      hWndShownFromParent = m_hWndShownFromParent
   Else
      hWndShownFromParent = m_hWnd
   End If
   If (Style = eComCtl32) Then
      lPopoutStart = -3000
      lPopoutExtent = 0
   End If
   ctlPopup.fSetShownFrom Me, hWndShownFromParent, ePopoutDirection, lPopoutStart, lPopoutExtent, cM.hMonitor
   If (index > 0) Then
      m_item(index).mouseOver = True
      m_item(index).ShowingMenu = True
      m_item(index).hWndMenu = lhWnd
      If Not (m_bPopup) And (m_bWrappable Or m_bMainMenu) Then
         fPaint
      Else
         fPaintOneButton index
      End If
         
      
      Dim barInt As cCommandBarInt
      Set barInt = mCommandBars.BarItem(m_sToolBarKey)
      For i = 1 To barInt.count
         If Not (i = index) Then
            If (m_item(i).mouseOver) Then
               m_item(i).mouseOver = False
               If (m_bWrappable Or m_bMainMenu) Then
                  fPaint
               Else
                  fPaintOneButton i
               End If
            End If
         End If
      Next i
   End If
   
   ' Set the style of the object so it works as a popup:
   Dim lStyle As Long
   lStyle = GetWindowLong(lhWnd, GWL_EXSTYLE)
   lStyle = lStyle Or WS_EX_TOOLWINDOW
   lStyle = lStyle And Not (WS_EX_APPWINDOW)
   SetWindowLong lhWnd, GWL_EXSTYLE, lStyle
   SetParent lhWnd, HWND_DESKTOP
   
   SetWindowPos lhWnd, HWND_TOPMOST, tR.Left, tR.Top, tR.Right - tR.Left, tR.Bottom - tR.Top, SWP_SHOWWINDOW
   '///////////////////////////////////////////Add!!
   'j = IsWindowVisible(lhWnd)
   'Debug.Print Timer, j
   If Is2000OrAbove Then
    lStyle = lStyle Or WS_EX_LAYERED
    SetWindowLong lhWnd, GWL_EXSTYLE, lStyle
    j = trans
    If j <= 0 Or j > 255 Then j = 255
    For i = 0 To j Step 32
     SetLayeredWindowAttributes lhWnd, 0, i, LWA_ALPHA
     If i = 0 Then ctlPopup.fPaint
     Sleep 10
    Next i
    If trans > 0 And trans < 255 Then
     SetLayeredWindowAttributes lhWnd, 0, trans, LWA_ALPHA
    Else
     lStyle = lStyle And Not WS_EX_LAYERED
     SetWindowLong lhWnd, GWL_EXSTYLE, lStyle
    End If
   End If
   '///////////////////////////////////////////
   ctlPopup.fShowMenuShadow
   ctlPopup.fPaint
   If (selectFirst) Then
      ctlPopup.fKeyDown vbKeyDown, 0
   End If
   
   If Not (m_bPopup) Then
      HidePopupsFromOtherControls m_hWnd
   End If
   ActiveMenu = lhWnd
   m_eMenuTrackMode = 1
   
End Sub

Friend Sub fCloseMenusInternal(ByVal bHide As Boolean, ByVal lhWndExclude As Long)
   
   Dim barInt As cCommandBarInt
   Set barInt = mCommandBars.BarItem(m_sToolBarKey)
   If Not (barInt Is Nothing) Then
      Dim i As Long
      Dim ctl As vbalCommandBar
      For i = 1 To barInt.count
         If (m_item(i).ShowingMenu) Then
            If ControlFromhWnd(m_item(i).hWndMenu, ctl) Then
               If Not (ctl Is Me) Then
                  ctl.fCloseMenusInternal True, lhWndExclude
               End If
            End If
            m_item(i).ShowingMenu = False
            m_item(i).hWndMenu = 0
            If Not (m_bWrappable Or m_bMainMenu) Then
               fPaintOneButton i
            End If
         End If
      Next i
      If (m_bWrappable Or m_bMainMenu) Then
         fPaint
      End If
      
   End If
   
   If m_bPopup Then
      If bHide Then
         fInUse = False
         If Not (m_cRightShadow Is Nothing) Then
            Dim Bar As New cCommandBar
            Bar.fInit m_hWnd, barInt.Key
            RaiseEvent AfterShowMenu(Bar)
            
            'Debug.Print "Would remove " & Hex(m_hWnd) & " from trail here"
            RemovePopupFromTrail m_hWnd
            
         End If
         ShowWindow m_hWnd, SW_HIDE
         If Not (m_cRightShadow Is Nothing) Then
            m_cRightShadow.Destroy
            Set m_cRightShadow = Nothing
         End If
         If Not (m_cBottomShadow Is Nothing) Then
            m_cBottomShadow.Destroy
            Set m_cBottomShadow = Nothing
         End If
      Else
         ActiveMenu = m_hWnd
      End If
   Else
      ActiveMenu = m_hWnd
   End If

   
End Sub

Friend Sub fCloseMenus(ByVal bHide As Boolean)
      
   fCloseMenusInternal bHide, m_hWnd
   
End Sub

Private Sub pMouseMove(ByVal button As MouseButtonConstants, ByVal Shift As ShiftConstants)
   
   '
   Dim tP As POINTAPI
   Dim iIndex As Long
   
   GetCursorPos tP
   If Not ((tP.x = m_tLastMousePos.x) And (tP.y = m_tLastMousePos.y)) Then
      LSet m_tLastMousePos = tP
      ScreenToClient m_hWnd, tP
      iIndex = fHitTest(tP.x, tP.y)
      If (menuInitiator = m_hWnd) Then
         If (iIndex = 0) Then
            Exit Sub
         Else
            fTrack button, iIndex
         End If
      Else
         fTrack button, iIndex
      End If
   End If
   
End Sub
Private Sub pMouseDown(ByVal button As MouseButtonConstants, ByVal Shift As ShiftConstants)
   '
   Dim tP As POINTAPI
   Dim iIndex As Long
   Dim barInt As cCommandBarInt
   
   GetCursorPos tP
   LSet m_tLastMousePos = tP

   ScreenToClient m_hWnd, tP
   iIndex = fHitTest(tP.x, tP.y)
   
   If (button = vbLeftButton) Then
      fTrack button, iIndex, True
      If (iIndex > 0) Then
         Set barInt = mCommandBars.BarItem(m_sToolBarKey)
         If (barInt.Item(iIndex).Enabled) Then
            If (barInt.Item(iIndex).Style = eSplit) Then
               If (m_item(iIndex).MouseOverSplit) Then
                  fDropDownButton iIndex
               End If
            Else
               fDropDownButton iIndex
            End If
         End If
      End If
   Else
      fTrack button, iIndex, False
      If (button = vbRightButton) Then
         Dim cBtn As cButton
         If (iIndex > 0) Then
            Set barInt = mCommandBars.BarItem(m_sToolBarKey)
            Set cBtn = New cButton
            cBtn.fInit m_hWnd, barInt.Item(iIndex).Key
         End If
         RaiseEvent RightClick(cBtn, tP.x, tP.y)
      End If
   End If
   '
End Sub
Private Sub pMouseUp(ByVal button As MouseButtonConstants, ByVal Shift As ShiftConstants)
   '
   Dim tP As POINTAPI
   
   GetCursorPos tP
   LSet m_tLastMousePos = tP
   ScreenToClient m_hWnd, tP
   
   pMouseUpInternal button, Shift, tP
   
   '
End Sub

Private Sub pMouseUpInternal( _
      ByVal button As MouseButtonConstants, _
      ByVal Shift As ShiftConstants, _
      tP As POINTAPI _
   )
Dim iIndex As Long
Dim i As Long
   
   iIndex = fHitTest(tP.x, tP.y)
   
   If (button = vbLeftButton) Then
      If Len(m_sToolBarKey) > 0 Then
         Dim barInt As cCommandBarInt
         Set barInt = mCommandBars.BarItem(m_sToolBarKey)
         If Not (barInt Is Nothing) Then
            If (iIndex > 0) Then
               If (barInt.Item(iIndex).CanAction(m_eOrientation, m_bPopup, m_bPopupVisibleChecks)) Then
                  If (m_item(iIndex).mouseOver) And (m_item(iIndex).mouseDown) Then
                     fClickButton (iIndex)
                  End If
               End If
            End If
            For i = 1 To barInt.count
               If (m_item(i).mouseDown) Or (m_item(i).MouseDownSplit) Then
                  m_item(i).mouseDown = False
                  m_item(i).MouseDownSplit = False
                  If Not (m_bWrappable Or m_bMainMenu) Then
                     fPaintOneButton i
                  End If
               End If
            Next i
            If (m_bWrappable Or m_bMainMenu) Then
               fPaint
            End If
         End If
      End If
      fTrack 0, iIndex
      If (iIndex > 0) Then
         If (m_bWrappable Or m_bMainMenu) Then
            fPaint
         Else
            fPaintOneButton iIndex
         End If
      End If
   Else
      fTrack 0, iIndex
   End If

End Sub

Private Function pbRightToLeft() As Boolean
   pbRightToLeft = UserControl.RightToLeft
End Function
Private Function plGetHFont() As Long
Dim lHDC As Long
Dim f As StdFont
   Set f = UserControl.Font
   lHDC = UserControl.hDC
   If (m_eOrientation = eTop) Or (m_eOrientation = eBottom) Then
      plGetHFont = m_fntCache.hFont(f, 0, lHDC)
   Else
      plGetHFont = m_fntCache.hFont(f, 2700, lHDC)
   End If
End Function
Private Function getFormParenthWnd(ByVal hWndControl As Long) As Long
Dim lhWnd As Long
Dim lhWndTest As Long
Dim lErr As Long
   On Error Resume Next
   lhWnd = UserControl.Parent.hWnd
   If Not (Err.Number = 0) Then
      On Error GoTo 0
      lhWndTest = GetParent(hWndControl)
      Do
         lhWnd = lhWndTest
         lhWndTest = GetParent(lhWnd)
      Loop While Not (lhWndTest = 0)
      getFormParenthWnd = lhWnd
   Else
      On Error GoTo 0
      getFormParenthWnd = lhWnd
   End If
End Function

Private Sub pUnSubclass()
   If Not (m_hWndParent = 0) Then
      DetachMessage Me, m_hWndParent, WM_ACTIVATEAPP
      DetachMessage Me, m_hWndParent, WM_SETTINGCHANGE
      m_hWndParent = 0
   End If
End Sub
Private Sub pSubClass()
   
   pUnSubclass
   
   m_hWndParent = getFormParenthWnd(m_hWnd)
   If Not (m_hWndParent = 0) Then
      AttachMessage Me, m_hWndParent, WM_ACTIVATEAPP
      AttachMessage Me, m_hWndParent, WM_SETTINGCHANGE
   End If
   
End Sub

Private Sub pInitialise()

   On Error Resume Next
   m_bDesignTime = Not (UserControl.Ambient.UserMode)
   If (Err.Number <> 0) Then m_bDesignTime = False
   
   On Error GoTo 0
   If Not (m_bDesignTime) Then
      m_hWnd = UserControl.hWnd
      mCommandBars.AddRef hWnd, Me
      Set m_cToolbarImageList = New cCommandBarImageList
      Set m_cMenuImageList = New cCommandBarImageList
      m_cToolbarImageList.DisabledColor = ButtonTextDisabledColor
      m_cToolbarImageList.HighlightColor = ButtonTextHotColor
      m_cMenuImageList.DisabledColor = ButtonTextDisabledColor
   End If
   
End Sub

Private Sub pTerminate()

   pUnSubclass

   If Not (m_hWnd = 0) Then
   
      m_cToolbarImageList.Destroy
      Set m_cToolbarImageList = Nothing
      m_cMenuImageList.Destroy
      Set m_cMenuImageList = Nothing

      Dim barInt As cCommandBarInt
      If Len(m_sToolBarKey) > 0 Then
         Set barInt = mCommandBars.BarItem(m_sToolBarKey)
         If Not barInt Is Nothing Then
            barInt.ReleaseRef m_hWnd
         End If
      End If
   
      mCommandBars.ReleaseRef hWnd
   End If
   m_hWnd = 0
   
End Sub

Private Property Let ISubclass_MsgResponse(ByVal RHS As EMsgResponse)
   '
   '
End Property

Private Property Get ISubclass_MsgResponse() As EMsgResponse
   '
   ISubclass_MsgResponse = emrPostProcess
   '
End Property

Private Function ISubclass_WindowProc(ByVal hWnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   '
   Select Case iMsg
   Case WM_ACTIVATEAPP
      If (wParam = 0) Then
         If (InMenuLoop) Then
            SetInMenuLoop False, m_hWnd
         End If
      End If
      
   Case WM_SETTINGCHANGE
      UserControl_Resize
      
   End Select
   '
End Function

Private Sub tmrLostMouse_Timer()
   '
   Dim tP As POINTAPI
   Dim tR As RECT
   Dim i As Long
   
   If (Me.Enabled) Then
      GetCursorPos tP
      If Not ((tP.x = m_tLastMousePos.x) And (tP.y = m_tLastMousePos.y)) Then
         LSet m_tLastMousePos = tP
   
         GetWindowRect m_hWnd, tR
         If (PtInRect(tR, tP.x, tP.y) = 0) Then
            If Not (menuInitiator = m_hWnd) Then
               fTrack 0, 0
            Else
               ' unhighlight the item if it is not showing a menu
               Dim barInt As cCommandBarInt
               Set barInt = mCommandBars.BarItem(m_sToolBarKey)
               If Not (barInt Is Nothing) Then
                  For i = 1 To barInt.count
                     If (m_item(i).mouseOver Or m_item(i).MouseOverSplit) Then
                        If Not (m_item(i).ShowingMenu) Then
                           fTrack 0, 0
                           Exit For
                        End If
                     End If
                  Next i
               End If
            End If
            tmrLostMouse.Enabled = False
         End If
      End If
   End If
   '
End Sub

Private Sub tmrMenuPopup_Timer()
   If IsNumeric(tmrMenuPopup.Tag) Then
      Dim index As Long
      index = CLng(tmrMenuPopup.Tag)
      Dim barInt As cCommandBarInt
      Set barInt = mCommandBars.BarItem(m_sToolBarKey)
      If (index > 0) And (index <= barInt.count) Then
      If (m_item(index).mouseOver) Then
         If Not (barInt.Item(index).Bar Is Nothing) Then
            If Not (m_item(index).ShowingMenu) Then
               pShowDropDown index
            End If
         Else
            Dim ctl As vbalCommandBar
            For index = 1 To barInt.count
               If (m_item(index).ShowingMenu) And Not (m_item(index).hWndMenu = 0) Then
                  If (ControlFromhWnd(m_item(index).hWndMenu, ctl)) Then
                     ctl.fCloseMenus True
                  End If
                  m_item(index).ShowingMenu = False
                  m_item(index).hWndMenu = 0
                  If Not (m_bWrappable Or m_bMainMenu) Then
                     fPaintOneButton index
                  End If
               End If
            Next index
            If (m_bWrappable Or m_bMainMenu) Then
               fPaint
            End If
         End If
      End If
      End If
   End If
   tmrMenuPopup.Enabled = False
End Sub

Private Sub UserControl_AmbientChanged(PropertyName As String)
   '
   'Debug.Print PropertyName
   '
End Sub

Private Sub UserControl_Initialize()
   '
   'Debug.Print ">> PREPARE FOR WAVE " + UserControl.Name
   
   ' Hack for XP Crash under VB6
   m_hMod = LoadLibrary("shell32.dll")
   InitCommonControls
   
   m_bEnabled = True
   m_bVisible = True
   m_bRedraw = True
   '
End Sub

Private Sub UserControl_InitProperties()
   '
   pInitialise
   '
End Sub

Private Sub UserControl_MouseDown(button As Integer, Shift As Integer, x As Single, y As Single)
   '
   If m_bInDragMode Then
      ' TODO
   Else
      pMouseDown button, Shift
   End If
   '
End Sub

Private Sub UserControl_MouseMove(button As Integer, Shift As Integer, x As Single, y As Single)
   '
   If m_bInDragMode Then
      ' TODO
   Else
      pMouseMove button, Shift
   End If
   '
End Sub

Private Sub UserControl_MouseUp(button As Integer, Shift As Integer, x As Single, y As Single)
   '
   If m_bInDragMode Then
      ' TODO
   Else
      pMouseUp button, Shift
   End If
   '
End Sub

Private Sub UserControl_Paint()
   '
   'fPaint
   '
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
   '
   pInitialise
   
   Dim defFont As New StdFont
   defFont.Name = "Tahoma"
   defFont.Size = 8.25
   Set Font = PropBag.ReadProperty("Font", defFont)
   m_bEnabled = PropBag.ReadProperty("Enabled", True)
   Orientation = PropBag.ReadProperty("Orientation", eTop)
   MainMenu = PropBag.ReadProperty("MainMenu", False)
   Style = PropBag.ReadProperty("Style", eOffice2003)
   '/////////Add!!
   trans = PropBag.ReadProperty("Transparency", 255)
   od = PropBag.ReadProperty("OwnerDraw", False)
   globalMenuText = PropBag.ReadProperty("MenuText", "")
   '
End Sub

Private Sub UserControl_Resize()
   '
   If Not (m_bResizeInterlock) Then
      m_bResizeInterlock = True
      If Not (m_bPopup) Then
         fResize
      End If
      RaiseEvent Resize
      m_bResizeInterlock = False
   End If
   '
End Sub

Private Sub UserControl_Terminate()
   '
   pTerminate
   
   If Not (m_hMod = 0) Then
      FreeLibrary m_hMod
      m_hMod = 0
   End If
   
   'Debug.Print ">> WAVE DEFEATED " + UserControl.Name
   '
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
   '
   PropBag.WriteProperty "Font", Font
   PropBag.WriteProperty "Enabled", m_bEnabled, True
   PropBag.WriteProperty "Orientation", m_eOrientation, eTop
   PropBag.WriteProperty "MainMenu", MainMenu, False
   PropBag.WriteProperty "Style", Style, eOffice2003
   '//////////Add!!
   PropBag.WriteProperty "Transparency", trans, 255
   PropBag.WriteProperty "OwnerDraw", od, False
   PropBag.WriteProperty "MenuText", globalMenuText, ""
   '
End Sub


'
'
' Noisy Playlist:
'
'  The Rapture - The Coming of Spring
'  Audio Bullys - I Go To Your House
'  Free Form Five - Perspex Sex (Ewan Pearson Mix)
'  Dead Prez - Hip Hop
'  Yeah Yeah Yeahs - Rich
'  Akufen - New Process
'  Dizzee Rascal - I Luv U
'  Dr Octagon - Bear Witness
'  New Flesh featuring Robotic EBU - Stick & Move
'  The Bug vs The Rootsman ft He-Man - Killer
'  Grandmaster Flash and The Furious Five - Scorpio (Plaid Remix)
'
'
' Fun Playlist:
'
'  Kid Koala - Drunk Trumpet
'  Barry Adamson - Something Wicked This Way Comes
'  Prince - Baby I'm A Star
'  Skee Lo - I Wish
'  Stevie Wonder - Sir Duke
'  The Jackson 5 - It's Great to be Here
'  Gladys Knight and the Pips - Bourgie Bourgie
'  The Chi-Lites - My First Mistake
'  Wade Marcus - Spinning Wheel
'
